Google
 

Trailing-Edge - PDP-10 Archives - BB-J939D-BM - binary/six12.b36
There are 6 other files named six12.b36 in the archive. Click here to see a list.
MODULE SIX36( IDENT='2-17', ADDRESSING_MODE(NOINDIRECT),
    %TITLE %STRING('Bliss-36 Language Debugger TOPS-',	! 
		    %IF %SWITCHES(TOPS10) %THEN '10 I/O' %ELSE '20 I/O' %FI)
%IF %VARIANT EQL 10
%THEN
	    LINKAGE(BLISS10), ENVIRONMENT(BLISS10_OTS)
%ELSE
	    LINKAGE(BLISS36C), ENVIRONMENT(BLISS36C_OTS)
%FI,
		NODEBUG, ENTRY(SIX36,SIX12,SIXXEQ))=
BEGIN
!
! Copyright (C) 1981, 1982, 1983, 1984
! Digital Equipment Corporation,  Maynard, Massachusetts  01754
!
! This software is furnished under a license for use only on  a
! single computer system and may be copied only with the inclu-
! sion of the above copyright notice.  This  software,  or  any
! other  copies  thereof, may not be provided or otherwise made
! available to any other person except for use on  such  system
! and  to  one who agrees to these license terms.  Title to and
! ownership of the software shall at all times remain in DEC.
!
! The information in this software is subject to change without
! notice and should not be construed as a commitment by Digital
! Equipment Corporation.
!
! DEC assumes no responsibility for the use or  reliability  of
! its software on equipment which is not supplied by DEC.
!
!
!
! MODULE DESCRIPTION
!
!	This module implements SIX36, the BLISS-36 debugger.  Considerable
!	credit is due to
!
!		CMU	- Weinstock, Wulf, Lane and Johnsson; for the
!				Debugging Control Module, 1974
!
!		DEC	- Ghanta, Lupton, et al; Enhancements in B10 support
!			- Brender, R.; Initial work for supporting B36 and the
!				TOPS-10/-20 support.
!
!		CMU	- Newcomer, J.; Considerable enhancements, particularly
!				SIGNAL|UNWIND support, qualified symbols and
!				all sorts of other goodies.
!
!
! REVISION HISTORY
!
!	30-Mar-81	AL	Translated from B10 with CVT10.  Major surgery
!				removing junk, attempting to rationally format
!				and comment. [Its own mother wouldn't recognize
!				it now!]
!
!	9-Apr-81	AL	Beginning to approach working code.  Most B10
!				and B36C stuff has been removed
!
!	9-Jul-81	AL	Fix problem with GETNAMEOP involving ^-6.  The
!				^ operator in B36 is signed, not so with B10!
!
!	13-Jul-81	AL	Added /VARIANT control for Bliss-10 Linkages
!
!       24-Jul-81       AL      Fix problems with TOPS-10 ideas about byte
!                               pointers vs. address.
!
!	14-Aug-81	AL	Work on fixing behavior of RETURN command and
!				faking a "call-frame" in CALLEM and UUOH.
!
!       1-Sep-81        AL      TOPS-10 problem in TTOUTC routine.  Also fixed
!				to avoid looking for HISEG symbol-table when
!				running with TOPS-20.
!
!	15-Oct-81	AL	n%A notation was bombing out due to wrong
!				frame being passed to GETARGCNT from
!				GETARGADR
!
!	26-Oct-81	AL	PRCALL incorrectly determined ID of condition
!				being signalled.
!
!	16-Nov-81	AL	Remove references to .EXT.0 and insert dummy
!				".BREG" as a new module at tail of this module.
!
!	22-Dec-81	AL	Make "@" issue "RESERVED for FUTURE use" msg.
!
!       28-Dec-81       AL      Dynamic mapping of DDT broken, as MJSYS wasn't
!                               used to define GET or SEVEC.
!
!	 8-Jun-82	TT	Move Maps to routine headers where possible.
!
!	18-Jun-82	AL	Implement support for extended addressing.
!
!	30-Jun-82	AL	Found out what "BGOBASE" does.
!
!
! END V3.1 BUG FIXES
!
! BLISS V4 DEVELOPMENT
!
!       22-Jul-82       AL      For TOPS-10, we must define $ARxxx symbols
!                               locally.
!
!	25-Jul-83	TT	Merge Bugs line into Main line.
!
!	13-Sep-83	LD	$JBxxx becomes EXTERNAL for TOPS-10
!				since it is now part of UUOSYM.
!
!	 9-Jan-84	MEA	UUOH was smashing AC2 and AC4 while doing Load
!				 Byte and Deposit Byte for field references.
!				 Fix is to save/restore those registers in OWN's
!				 when necessary.
!
!	 2-Feb-84	MEA	Fix to change of 9-Jan-84.  For BLISS-10 version
!				 of SIX12, AC1 is used instead of AC2.
!
! END OF REVISION HISTORY
!--
LITERAL
    EXTENDED = %VARIANT EQL 30,	! 30-bit addressing?
    TOPS10 = %SWITCHES(TOPS10),
    TOPS20 = %SWITCHES(TOPS20),

%IF EXTENDED
%THEN
    AddrMask = %O'37777777'
%ELSE
    AddrMask = %O'0777777'
%FI;

BIND VERSION = UPLIT (%ASCIZ 'V8-7') 	:VECTOR;

MACRO
    S1036(X,Y) = %IF %VARIANT EQL 10 %THEN X %ELSE Y %FI %,

    NPREGS=	%IF %VARIANT EQL 10
		%THEN
		    1,3,4,5,6,7,8,9,10
		%ELSE
		    2,3,4,5
		%FI %,

    PRREGS=	%IF %VARIANT EQL 10
		%THEN
		    11,12,13,14,15
		%ELSE
		    0,6,7,8,9,10,11,12,14
		%FI %;


GLOBAL BIND
    SREG	= S1036( 0,%o'17'),	! Default SP for B36 linkages
    FREG	= S1036( 2,%o'15'),	! Default FP
    VREG	= S1036( 3,%o'1');	! Default value-return register

LITERAL
    TRUE = 1,
    FALSE = 0,
    SIXUNW = %O'7170',		! Random number used to signal a POP

    SLOWDELETE=0;		! 1 to purge symbols, 0 to clobber them
				! Must be 0 until some detailed fixing of
				! the code is done; currently the purge
				! code is commented out

! These Binds control size of problem
! -----------------------------------

LITERAL
    BGOBASE=20,			! I haven't the foggiest notion what this
				! does! -jmn 6-Jan-81
				! Ans:
				!	It controls the number of DEBUG UUOs
				!	executed before checking for typeahead.

    BUFFERSIZE= CH$ALLOCATION(132),	! Size of input buffer in words
    EXTRAOPS= 20,		! Number of permitted user-defined
				!  operators
    LEVELS=10,			! Maximum nesting depth of SIX12 calls
    MONITCNT=50,		! Number of locations we can MONITOR/WATCH
    NMACROS=500,
    OPSIZE=5,			! Size of the dispatch op table entry
    ROUTSCNT=50,		! Number of routines we can attach actions
				!  to
    ROUTSIZE=5,			! Size of the routine-action table
    SCRATCHSIZE=20,		! Size of SIXPAT area
    STACKSIZE=50;		! Maximum depth of parse stack


LITERAL					! Useful initial values
    BIGNUMBER = %O'377777777777',	! Biggest positive number
    IWDBASE = %O'1000';			! Initial offset of WDBase

BUILTIN
    FIRSTONE,
    LSH,
    POINT,
    REPLACEN,
    SCANN,
    MACHOP,
    MACHSKIP,
    UUO,
    ROT;

MACRO				    ! Random useful machine opcodes we need
    AOS[] = MACHSKIP(%O'350', %REMAINING) %,
    BLT[] = MACHOP(%O'251', %REMAINING) %,
    EXCH[] = MACHOP(%O'250', %REMAINING) %,
    JRST[] = MACHOP(%O'254', %REMAINING) %,
    IBP[] =	MACHOP(%o'133', 0, %REMAINING) %,
    MUL[] = MACHOP(%O'224', %REMAINING) %,
    POP[] = MACHOP(%O'262', %REMAINING) %,
    POPJ[] = MACHOP(%O'263', %REMAINING) %,
    PUSH[] = MACHOP(%O'261', %REMAINING) %,
    XCT[] = MACHOP(%O'256', %REMAINING) %;

LITERAL			    ! These are values of machops which we need as
			    ! literals
    ADDOP=%O'270',
    ADJSPOP= %O'105',
    CAIOP=%O'300',
    JFCLOP=%O'255',
    JRSTOP=%O'254',
    JSPOP = %O'265',
    POPJOP = %O'263',
    PUSHJOP = %O'260',
    PUSHOP = %O'261',
    SUBOP=	%O'274';

%IF TOPS10
%THEN
LIBRARY 'BLI:UUOSYM';


UNDECLARE
    %QUOTE CLOSE,
    %QUOTE ENTER,
    %QUOTE IN,
    %QUOTE INBUF,
    %QUOTE INPUT,
    %QUOTE LOOKUP,
    %QUOTE OPEN,
    %QUOTE OUT,
    %QUOTE OUTBUF,
    %QUOTE RESET,
    %QUOTE SETUWP,
    %QUOTE STATO,
    %QUOTE STATZ,
    %QUOTE SKPINL,
    %QUOTE WHERE,
    %QUOTE OUTCHR,
    %QUOTE INCHRS,
    %QUOTE OUTSTR,
    %QUOTE INCHWL,
    %QUOTE INCHSL,
    %QUOTE GETLCH,
    %QUOTE SETLCH,
    %QUOTE SKPINC;


MACRO
    CALLI[] = MACHOP(%O'47', %REMAINING) %,
    CLOSE[] = MACHSKIP(%O'70', %REMAINING) %,
    ENTER[] = MACHSKIP(%O'77', %REMAINING) %,
    IN[] = MACHSKIP(%O'56', %REMAINING) %,
    INBUF[] = MACHOP(%O'64', %REMAINING) %,
    LOOKUP[] = MACHSKIP(%O'76', %REMAINING) %,
    OPEN[]   = MACHSKIP(%O'50', %REMAINING) %,
    OUT[] = MACHSKIP(%O'57', %REMAINING) %,
    OUTBUF[] = MACHSKIP(%O'65', %REMAINING) %,
    RELEASE[]= MACHSKIP(%O'71', %REMAINING) %,
    SETUWP(A)=  MACHSKIP(%O'47', A, %O'36') %,
    STATO[] =  MACHSKIP(%O'61', %REMAINING) %,
    STATZ[] =  MACHSKIP(%O'63', %REMAINING) %,
    TTCALL[] = MACHOP(%O'51', %REMAINING) %,
    SKPINL(D) = MACHSKIP(%O'51',%o'14') %,
    OUTCHR[] = TTCALL(1, %REMAINING) %,
    INCHRS[] = TTCALL(2, %REMAINING) %,
    OUTSTR[] = TTCALL(3, %REMAINING) %,
    INCHWL(D) = TTCALL(4, D) %,
    INCHSL(D) = MACHSKIP(%O'51',5,D) %,
    GETLCH[] = TTCALL(6, %REMAINING) %,
    SETLCH[] = TTCALL(7, %REMAINING) %,
    SKPINC(D) = MACHSKIP(%O'51',%o'13',D) %;

LITERAL
       $AROPC   = 0,
       $ARPFL   = 1,
       $AREFA   = 2,
       $ARNPC   = 3;

EXTERNAL

	$JBDA,
	$JBDDT,			! DDT start address
	$JBFF :  VOLATILE,	! Start of free storage
	$JBHRL,			! Vestigial (hiseg) .JBREL
	$JBREL,			! Physical end of lowseg
	$JBSYM,			! Pointer to DDT symbol table
	$JBUSY			! Undefined symbol chain
%IF NOT EXTENDED
%THEN
	,$JBOPC,		! Old PC
	$JB41,			! UUO location
	$JBUUO			! Location where last UUO was stored
%FI
	    ;
%FI

%IF TOPS20
%THEN
LIBRARY 'BLI:MONSYM';

MACRO
    MJSYS(NAME,SKIPCNT,INREG,OUTREG)=
	%ASSIGN(JSYSNO,NAME)
	UNDECLARE NAME;

	LINKAGE %NAME('L_',NAME) = JSYS (
		%IF NOT %NULL(INREG) %THEN RPLIST( %REMOVE(INREG) ) %FI
		%IF NOT %NULL(OUTREG) %THEN ; RPLIST( %REMOVE(OUTREG) ) %FI
			)
		:SKIP(SKIPCNT);

	BIND ROUTINE NAME = JSYSNO: %NAME('L_',NAME); %,

    RPLIST(A)[] = REGISTER=A %IF %LENGTH GTR 1 %THEN ,RPLIST(%REMAINING) %FI %;


COMPILETIME
    JSYSNO=0;

!   JSYS Name  Skips	Inputs		Outputs
!
MJSYS(  AIC, 	0,	(1,2),			)	! activate specific software interrupt channels
MJSYS(  ATI,	0,	(1),			)	! assign terminal code CTRL/CHARACTER
MJSYS(	BIN,	-1,	(1),		(2)	)	! Byte IN
MJSYS(	BKJFN,	1,	(1),		(1)	)	! BacK up source JFN
MJSYS(	BOUT,	0,	(1,2),			)
MJSYS(	CHFDB,	-1,	(1,2,3),		)	! change file block
MJSYS(	CLOSF,	1,	(1),		(1)	)
MJSYS(	CRLNM,	1,	(1,2,3),	(1)	)	!Create logical name
MJSYS(  DELDF,  -1,     (1,2),		  )       ! Expunge deleted files
MJSYS(	DELNF,	1,	(1,2),		(1,2)	)	!Delete given number of versions
MJSYS(  DIC,	0,	(1,2),			)	! deactivates a specified interrupt channel
MJSYS(	DIRST,	1,	(1,2),		(1)	)	!Get user directory name
MJSYS(	DISMS,	0,	(1),			)	!Dismiss process for specified time
MJSYS(	DVCHR,	0,	(1),		(1,2,3)	)
MJSYS(  EIR,	0,	(1),			)	! enable software interrupt system
MJSYS(	ERSTR,	2,	(1,2,3),		)	!Translate error code
MJSYS(  GET,    -1,     (1,2),                  )       !Map image into process
MJSYS(	GETER,	-1,	(1),		(2)	)	!Get error code
MJSYS(	GETJI,	1,	(1,2,3),		)	!Get job information
MJSYS(	GEVEC,	0,	(1),		(2)	)	!Get Entry Vector
MJSYS(	GNJFN,	1,	(1),		(1)	)	!Get next JFN in group
MJSYS(	GTAD,	0,	,		(1)	)	!Get date, time in internal form
MJSYS(	GTJFN,	1,	(1,2),		(1)	)
MJSYS(	GTFDB,	-1,	(1,2,3),		)
MJSYS(	HALTF,	0,	,			)	!Exit to monitor
MJSYS(  IDTIM,  1,      (1,2),	  (1,2)   )       !translate text into interal date-time format
MJSYS(	JFNS,	0,	(1,2,3,4),	(1)	)
MJSYS(	LNMST,	1,	(1,2,3),	(1,3)	)	!Translate logical name
MJSYS(	ODTIM,	0,	(1,2,3),	(1)	)	!Get date and time
MJSYS(	OPENF,	1,	(1,2),		(1)	)
MJSYS(	PBOUT,	0,	(1),			)
MJSYS(	PSOUT,	0,	(1),		(1)	)
MJSYS(	RCDIR,	-1,	(1,2,3),	(1,2,3)	)	!Get directory info
MJSYS(	RDTTY,	1,	(1,2,3),	(1,2)	)	!Read from primary input
MJSYS(	RESET,	0,	,			)	! Init current process
MJSYS(	RFMOD,	0,	(1),		(2)	)
MJSYS(  RLJFN,  1,      (1),	    (1)     )       ! Release JFN
MJSYS(	RPACS,	0,	(1),		(2)	)	! Page Accessibility
MJSYS(	RSCAN,	1,	(1),			)	!get string from rescan buffer
MJSYS(	RUNTM,	0,	(1),		(1,2,3)	)
MJSYS(  SEVEC,  -1,     (1,2),                  )
MJSYS(	SFMOD,	0,	(1,2),			)
MJSYS(	SFPTR,	1,	(1,2),		(1)	)
MJSYS(	SIBE,	1,	(1),		(2)	)	! Skip if input empty
MJSYS(	SIN,	-1,	(1,2,3,4),	(1,2,3)	)
MJSYS(  SIR,	0,	(1,2),			)	! set channel and priority table addresses
MJSYS(	SOUT,	0,	(1,2,3,4),	(1,2,3)	)
MJSYS(	SPACS,	0,	(1,2),			)	! Set page accessability
MJSYS(	SWTRP_, 0,	(1,2,3),		)	! Software Trap Set

MJSYS(	TEXTI,	1,	(1),		(1)	)
MJSYS(	TIME,	0,	,		(1,2)	)

UNDECLARE
    JSYSNO,
    %QUOTE MJSYS,
    %QUOTE RPLIST;

MACRO
    JBDEF[N]=	EXTERNAL %NAME('.',N); BIND %NAME('$',N)=%NAME('.',N); %;

JBDEF(			! Conspicuous by their absence: .JBHGH, .JBHSM, .HIGH.

	JBDA,
	JBDDT,			! DDT start address
	JBFF,			! Start of free storage
	JBHRL,			! Vestigial (hiseg) .JBREL
	JBREL,			! Physical end of lowseg
	JBSYM,			! Pointer to DDT symbol table
	JBUSY			! Undefined symbol chain
%IF NOT EXTENDED
%THEN
	,JBOPC,			! Old PC
	JB41,			! UUO location
	JBUUO			! Location where last UUO was stored
%FI
	);

MAP
    $JBFF	: VOLATILE;
%FI

EXTERNAL
	%NAME('EFPNT.'),	! BLISS Enable Frame pointer
	%NAME('SIGND.');	! Marks end of condition-handling code in OTS

EXTERNAL ROUTINE
	%NAME('SIGST.'),
	%NAME('SIGNA.');

BIND
    EFPNT$	= %NAME('EFPNT.'),
    SIGND$	= %NAME('SIGND.');

BIND ROUTINE
    SIGST$	= %NAME('SIGST.'),
    SIGNA$	= %NAME('SIGNA.');
! Storage Declarations
! --------------------

GLOBAL
    SIXPAT:	VECTOR[SCRATCHSIZE+1],		! PATCH AREA
    SIXHDR,			! User parameter printer handler
    SIXRP	: REF VECTOR,	! Pointer to right operand vector
    SIXLP	: REF VECTOR,	! Pointer to left operand vector
    SIXVP	: REF VECTOR,	! Pointer to value-return vector
    SIXRC,			! Count of right operands
    SIXLC,			! Count of left operands
    SIXVC,			! Count of values returned
    SIXREF,			! Means "use ref-structure" if true
    SIXVREG,			! User readable/writable VREG value
    SIXCH,	! LG change	! Communicates with SIXLG interface in LG support
    SIXSTK,			! Initial stack pointer value
    SIXACS:	VECTOR[16];	! Saved acs when calling DDT


BIND
    SIXUNWSIGNAL = SIXUNW,	! random number---signals a POP
    CHAR = SIXCH;		! LG change

GLOBAL BIND
	SIXSP = SREG;		! Stack pointer register number

EXTERNAL LITERAL		! Refers to globals defined in inner block.
				! In this way, they may be changed at Link time
    SIXLSF,			! Delete SIX12 local symbols flag value
    SIXSTF,			! Initial start flag value
    SIXENF,			! Initial enable flag value
    SIXPOL;			! Initial polling flag value


OWN
    STARTFLAG:	INITIAL(SIXSTF),	! This must be the VERY FIRST own!
    ENABFLAG:	INITIAL(SIXENF),	!on/off	! This must be the VERY SECOND own!
    NOPOLLFLAG:	INITIAL(SIXPOL),	! This must be the VERY THIRD own!
    COPQFLAG,				!on/off	! This must be the VERY FOURTH own

!----------------------
!	Remaining own variables in alphabetical order

%IF EXTENDED
%THEN
    $JBOPC,					! Dummy .JBOPC to reenter SIX12
    $JBUUO,					! Dummy holding copy of LUUO
    $JB41,					! Dummy holding LUUO dispatch
%FI

    BUFF:	VECTOR[BUFFERSIZE],		! Input buffer for text line
    DBGSTK:	VECTOR[STACKSIZE],		! Parse/evaluation stack
    DCNT,					! Controls DEBUG. sampling rate
						!  for type-ahead.
    DEFOPTAB:	VECTOR[OPSIZE*EXTRAOPS],	! User defined operator table
    DEPTH,					! Current nesting depth for n& prompt
    DISKIFLAG,			!on/off	! Disk character input flag (RECALL)
    DISKOFLAG,			!on/off	! Disk character output flag (STORE)
    DSKHDR:	VECTOR[3],		! Buffer header for disk (TOPS-10)
    ENTERPNT,				! Saved FP at entry to SIX12
    ENTERSP,				! Saved SP relative to ENTERPNT
    ERRORFLAG,			!on/off	! Error seen during evaluation
    ERRORPARM,				! Used to pass information to Error(n)
    GOFLAG,				! Controls resumption after command
					! 0 => no prompt, get more commands
					! 1 => resume processing
					! 2 => prompt, get more commands
    GQUALIFIER,				! global (default) name qualifier
    HCACHE:	INITIAL(0),		! cache of hiseg symbols
    HIGH:	INITIAL(0),		! value of .HIGH. if found
    HQUALIFIER,				! symbol table (.?.JBSYM or 
					! .(?.JBHGH+?.JBHSM)) in which
					! Qualifier is defined
    HSYM,				! Condition of highseg symbols:
					!   0 - unknown
					!   1 - must recompute hiseg symbol table
					!  
    INSIXHDR,				! Used to detect and ignore recursive
					! call on SIX12 caused by calling the
					! routine defined in SIXHDR
    IOBASE,				! base for number conversion
    IJOBSYM:	INITIAL(0),		! initial .JBSYM
    IJOBHSM:	INITIAL(0),		! initial .JBHSM
    ILLMEM,				! Value which caused ill mem ref
    JOBHGH:	INITIAL(0),		! value of .JBHGH, if found
    LGCHAR,				! LG change
    LPTBUF:	VECTOR[%O'203'],	! Output buffer for LPT output
    LPTFLAG,				! Line printer output flag
					! >0 => LPTDUP
					! =0 => no LPT
					! <0 => LPTON
    LPTHDR:	VECTOR[3],		! Header for line printer buffer chain
    LPTOPENFLAG,		!on/off	! Line print file open flag
    MODEFLAG,				! Used to aid parsing of multiword
					! operators, e.g., TRACE AFTER
    NCHAR,
    NEWOPS,				! Number of new operators via SIXOP or
					! DEFINE
    NNAMES,
    NPCHAR,
    NROUTS,				! Index of last entry in debug interest
					! table (ROUTS)
    NVALS,				! Index of last entry in MONITOR table
    OPQCNT,				! Tracks number of OPAQUEs
    OUTERSIGNAL:	VECTOR[4],	! Signal frame for outermost handler (B36 only)
    PCHAR:	VECTOR[LEVELS],		! Current character being scanned
    PARSEDEBUG,				
    PTEXT,				
    QUOTFLG,				! Should next symbol be evaluated or
					!  delivered as radix50?
    REPORTED,				! Indicates trace output has already
					!  occurred, additional printout not
					!  required
    RTNLVL,				! Routine POSITION:
					! 1 => AT Routine EXIT,
					! 0 => AT Routine ENTRY,
					! -1 => OTHERWISE.

    SAWCR,			! Indicates parser saw CR on this line
    SAWEOF,			! EOF on disk input during RECALL
    SIXTOG,
    STEPFLAG,				! true if in single-step mode
    SWT		: BLOCK[$ARNPC+1],	! Data-block for LUUO fault data
    TEXTAREA:	VECTOR[2*NMACROS],	! Allowing avg. 9 chars/Macro; Change routine 'GetText' if changed
    TOPOP,
    TOPSTK,				! index of top of evaluation stack
    TRACEFLAG,				! global tracing is enabled
    TRCCNT,
    UNWINDVALUE:	INITIAL(0),	! The value of SS$UNW, obtained from DDT symbol table
    VTEMP,
    WDBASE:	INITIAL(IWDBASE),	! Maximum offset for symbolic printout
    WHACKING,				! doing simultaneous UNWIND with Whacking
    WHACKS;				! number of SIX12 incarnations to Whack off


GLOBAL BIND
	SIXSTA = STARTFLAG,
	SIXENB = ENABFLAG,
	SIXNPL = NOPOLLFLAG;
! Macro Table Entry Format
! ------------------------

!   +-----------------------------------------------------------------------+
! 0 |			       MACRO_NAME				    |
!   +-----------------------------------------------------------------------+
! 1 |   			    RAD50NAME				    |
!   +-----------------------------------------------------------------------+

FIELD
    MACRO_FIELDS=
	SET
	MACRO_NAME=     [0, 0,36,0],	    ! Macro name in SIXBIT
	MACRO_BODY=     [1, 0,36,0]	     ! CH$ pointer to body string
	TES;

OWN
    SIXNAMES:	BLOCKVECTOR[NMACROS,2] FIELD(MACRO_FIELDS);	! Storage for MACRO names, etc.

LITERAL
	QUALPREFIX = 1,
	QUALSUFFIX = 0,

	DORESUME=0,
	DORESIGNAL=1;
! Some useful macros
! ------------------

MACRO
	RNAME=	$JBUUO<RH> %,
	RH=0,18  %,
	LH=18,18 %,
	FW=0,36, 0 %,
	WATCHFLAG=23,1,0 %,

	BITFIELD(N)=N,1,0 %,
	BITVAL(N)=1^(N) %,
	MASK_[] = (0 OR XMASK_[%REMAINING]) %,
	XMASK_[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(DUMMY)=(RTNLVL = -1) %,
	SETISEXIT(DUMMY)=(RTNLVL = ISEXIT) %,
	OUTFLAG(DUMMY)=OUTFLAGRTN() %,

	DDTEND	= (.$JBDDT<LH>) %;


MACRO OPRETURN(X)=
	!+
	! Forms fullword encoding of OPERATOR
	!-
	(  .X + 1
	 + ((((.(.X+1) NEQ 0) ^1
	    + (.(.X+2) NEQ 0))^1
	    + (.(.X+3) NEQ 0))^1
	    + (.(.X+4) NEQ 0))   ^  18) %;

MACRO
    DBG_ON_INST =
	%IF EXTENDED %THEN
		(JRSTOP^27+ UUOH)
	%ELSE
		(PUSHJOP^27 OR SREG^23 OR UUOH)
	%FI %,

    DBG_OFF_INST =
	%IF EXTENDED %THEN
		(JRSTOP^27 OR 2^23 OR 1^22 OR SWT[$AROPC,FW])
	%ELSE
		(JFCLOP^27)
	%FI %;

MACRO	BUGCHECK(CODE,ACTION)=
	IF .$JB41 EQL DBG_OFF_INST THEN (ERROR(CODE); ACTION) %;
! Machine Instruction Format
! ---------------------------


!   35		   27 26    23   21   18 17				    0
!   +----------------+--------+-+-------+-----------------------------------+
!   |    M_OPCODE    | M_REGF |*|M_INDEX|	    M_OFFSET		    |
!   +----------------+--------+-+-------+-----------------------------------+
!
!	*	- M_INDIRECT
!

FIELD
    INSTRUCTION_FIELDS=
	SET
	M_OPCODE=	[0,27,9,0],		! Op-code field
	M_REGF=		[0,23,4,0],		! AC field
	M_INDIRECT=	[0,22,1,0],		! Indirect bit
	M_INDEX=	[0,18,4,0],		! Index register
	M_OFFSET=	[0, 0,18,0],		!
	M_LHALF=	[0,18,18,0],		! All opcode, AC and indirect
	M_IMMEDIATE=	[0,0,18,1]		! Signed immediate value
	TES;

MACRO
    $INSTRUCTION=	BLOCK[1] FIELD(INSTRUCTION_FIELDS) %;

! Byte Pointer Format
!
!   35	    30 29    24 23 22 21     18 17				   0
!   +---------+--------+--+--+---------+-----------------------------------+
!   | P_POS   | P_SIZE |  | %| P_INDEX |	    P_OFFSET		   |
!   +---------+--------+--+--+---------+-----------------------------------+
!
!  % - P_INDIRECT

FIELD
    BYTEPOINTER_FIELDS=
	SET
	P_LHALF=	[0, 18,18,0],		! Left half of pointer
	P_POS=		[0, 30,6,0],		! Field position
	P_SIZE=		[0, 24,6,0],		!  and size
	P_POS_SIZE=	[0, 24,12,0],		! Combination for <0,36> checks
	P_INDIRECT=	[0, 22,1,0],		! Indirect bit
	P_INDEX=	[0, 18,4,0],		! Index Register
	P_OFFSET=	[0, 0,18,0],		! Displacement Value
	P_FWORD=	[0, 0,36,0]		! Entire pointer value
	TES;

MACRO
    $BYTE_POINTER=	BLOCK[1] FIELD(BYTEPOINTER_FIELDS) %;
! Symbol Table Data Structures
! ----------------------------


!   +--+----+---------------------------+-----------------------------------+
! 0 |* |  & |			    RAD50NAME				    |
!   +-----------------------------------+-----------------------------------+
! 1 |		SYMBOLCNT		|	    SYMBOLVAL		    |
!   +-----------------------------------+-----------------------------------+
!
!	*	- INVALIDFLAG
!	&	- RAD50FLAG
!

STRUCTURE
    !+
    ! This is a REF BLOCK structure which uses only an 18-bit offset to
    ! deal with indirection.  Typically the left-half will be a negative
    ! count (or trash).
    !-
    HBLOCK[OFF, P,S,E; SIZE=1] = [SIZE] ( (.HBLOCK<RH>)+OFF)<P,S,E>;

MACRO
    SYMBOL=	HBLOCK[1] FIELD(DDT_FIELDS) %;

FIELD
    DDT_FIELDS=
	SET
	NAMEWRD=	[0,0,36,0],
	VALUEWRD=	[1,0,36,0],
	ADDRWRD=	[1,0, %IF EXTENDED %THEN 30 %ELSE 18 %FI, 0],

	INVALIDFLAG=	[0,35,1,0],		! Symbol is purged from symtab
	RAD50FLAG=	[0,32,2,0],
	RAD50NAME=	[0,0,32,0],
	SYMBOLVAL=	[1,0,18,0],		! "Address" value (18-bits)
	SYMBOLCNT=	[1,18,18,1]		! # of symbols in module when
						!  ste is DDT$_MODULE type.
	TES;

LITERAL
    DDT$_MODULE	= 0,		! RAD50FLAG values
    DDT$_GLOBAL = 1,		! Defined as GLOBAL symbol
    DDT$_OWN=	  2;		! Defined as non-global

! MODULE_PTR
!
!   +-----------------------------------+-----------------------------------+
! 0 |	    MODSYMCNT			|	    MODSYMPTR		    |
!   +-----------------------------------+-----------------------------------+

FIELD
    MODULE_FIELDS=
	SET
	MODSYMPTR = [ 0, 0,18,0],
	MODSYMCNT = [ 0,18,18,1]
	TES;

MACRO
    MODULEPTR = BLOCK[1] FIELD(MODULE_FIELDS) %;
FORWARD ROUTINE
	ACTBIT2NAM,
	ACTNAM2BIT,
	ADVANCE	 : NOVALUE,
	B36ISUB		: NOVALUE,
	BEGINSIX12	: NOVALUE,
	BOOBOO		: NOVALUE,
	CALL1		: NOVALUE,
	CALL2		: NOVALUE,
	CALLENABLED,
	CFINDR,
	CHKCOND,
	CINSERT,
	CKVALS		: NOVALUE,
	CLOSELPT	: NOVALUE,
	CLRSTEP		: NOVALUE,
	COLON		: NOVALUE,
	CONTENTS	: NOVALUE,
	COPYR		: NOVALUE,
	CREMOVE		: NOVALUE,
	DABREAK		: NOVALUE,
	DBLEQL		: NOVALUE,
	DBREAK		: NOVALUE,
	DISAB		: NOVALUE,
	DOMON		: NOVALUE,
	DOPAQUE		: NOVALUE,
	DOTVREG,
	DSTABREAK	: NOVALUE,
	DTRACE,
	ENDSIX12	: NOVALUE,
	EQUALS		: NOVALUE,
	EQUALS0,
	ERROR,
	EXECUTE		: NOVALUE,
	EXITHANDLER	: NOVALUE,
	EXITSIGNAL	: NOVALUE,
	F50TO6,
	F50TO7,
	F7TO50,
	FIELDSPEC	: NOVALUE,
	FILEOPEN,
	FINDMODULE,
	FNDDBGUUO,
	GETARGADR,
	GETARGBASE,
	GETARGCNT,
	GETCALLFROM,
	GETLCLCNT,
	GETLCLADR,
	GETNAMEOP,
	GETNUMBER,
	GETOP,
	GETSTRING	: NOVALUE,
	GETSYMBOL,
	GETTEXT		: NOVALUE,
	GOER		: NOVALUE,
	GQUAL,
	INCHARS,
	INITSIX12	: NOVALUE,
	INPUT,
	INTEXT		: NOVALUE,
	INWORD,
	ISADDRESS,
	ISREADABLE,
	ISROUTINE,
	ISUB,
	ISUBSIG,
	ISWRITABLE,
	JOIN		: NOVALUE,
	KILLSYMBOL	: NOVALUE,
	LGFLD		: NOVALUE,
	LGVEC		: NOVALUE,
	LPAREN,
	LPTDUP		: NOVALUE,
	LPTOFF		: NOVALUE,
	LPTON		: NOVALUE,
	LPTOUT		: NOVALUE,
	MODDDT,
	NOSIX12		: NOVALUE,
	NOSIXSYMS	: NOVALUE,
	NSDDTFA,
	NSDDTW,
	OPAQUE		: NOVALUE,
	OPENLPT		: NOVALUE,
	OPERATE		: NOVALUE,
	OUTC		: NOVALUE,
	OUTCRLF		: NOVALUE,
	OUTERHANDLER,
	OUTFLAGRTN	: NOVALUE,
	OUTN,
	OUTQUAL		: NOVALUE,
	OUTSA		: NOVALUE,
	OUTTEXT		: NOVALUE,
	OUTVALUE	: NOVALUE,
	OUTWORD		: NOVALUE,
	PDEBUG,
	PPSYM		: NOVALUE,
	PR1ACTION       : NOVALUE,
	PR1MACRO	: NOVALUE,
	PRBPTR		: NOVALUE,
	PRCALL,
	PRCOUNTEDVECTOR	: NOVALUE,
	PRDISP		: NOVALUE,
	PRG		: NOVALUE,
	PRHANDLER,
	PRHPARMS	: NOVALUE,
	PRM		: NOVALUE,
	PRMVALSNAM	: NOVALUE,
	PROP		: NOVALUE,
	PRQ50,
	PRQUAL		: NOVALUE,
	PRQUALBP	: NOVALUE,
	PRS		: NOVALUE,
	PRSTK		: NOVALUE,
	PRSYM50,
	PRSYM6,
	PRXDISP		: NOVALUE,
	PSTK		: NOVALUE,
	PUSHITEM	: NOVALUE,
	PUSHOPER	: NOVALUE,
	RABREAK		: NOVALUE,
	RBREAK		: NOVALUE,
	RET612		: NOVALUE,
	ROPQAFT		: NOVALUE,
	ROPQAT		: NOVALUE,
	RTABREAK	: NOVALUE,
	RTRCAFT		: NOVALUE,
	RTRCAT		: NOVALUE,
	SDDTFS,
	SETAFTER	: NOVALUE,
	SETBIT		: NOVALUE,
	SETFROM		: NOVALUE,
	SETTBLBIT	: NOVALUE,
	SIX12A,
	SIX36,
	SIXDD2		: NOVALUE,
	SIXDDT		: NOVALUE,
	SIXDPY		: NOVALUE,	! global
	SIXID		: NOVALUE,
	SIXOP,				! global
	SIXXEQ,				! global
	SLASH		: NOVALUE,
	STABREAK	: NOVALUE,
	STOPIT		: NOVALUE,
	STRUCT		: NOVALUE,
	SYNTAX,
	TTOUTN		: NOVALUE,
	TYPE,
	UNSETBIT,
	UUOH		: NOVALUE,
	XABREAK		: NOVALUE,
	XADD		: NOVALUE,
	XAND		: NOVALUE,
	XASSIGN		: NOVALUE,
	XBACKTO		: NOVALUE,
	XBASE		: NOVALUE,
	XBIND		: NOVALUE,
	XBREAK		: NOVALUE,
	XCALL		: NOVALUE,
	XCLRTRACE	: NOVALUE,
	XCOPAQUE	: NOVALUE,
	XDDT		: NOVALUE,
	XDEBUG		: NOVALUE,
	XDEFINE		: NOVALUE,
	X2DEFINE	: NOVALUE,
	XDEL1		: NOVALUE,
	XDEL2		: NOVALUE,
	XDIV		: NOVALUE,
	XDMONITOR	: NOVALUE,
	XEQL		: NOVALUE,
	XEQOR		: NOVALUE,
	XGEQ		: NOVALUE,
	XGO		: NOVALUE,
	XGOCLR		: NOVALUE,
	XGOTRACE	: NOVALUE,
	XGTR		: NOVALUE,
	XHELP		: NOVALUE,
	XLOAD		: NOVALUE,
	XMACRO		: NOVALUE,
	XMONITOR	: NOVALUE,
	XNOCOPAQUE	: NOVALUE,
	XNOT		: NOVALUE,
	XOK		: NOVALUE,
	XLCALL		: NOVALUE,
	XLEQ		: NOVALUE,
	XLSS		: NOVALUE,
	XNEQ		: NOVALUE,
	XNOPOLLOFF	: NOVALUE,
	XNOPOLLON	: NOVALUE,
	XPOP		: NOVALUE,
	XPRINT,
	XPRINT0,
	XPRINTACT       : NOVALUE,
	XPRINTMACRO	: NOVALUE,
	XPRINTMON	: NOVALUE,
	XPRINTOPER	: NOVALUE,
	XPRM		: NOVALUE,
	XPRS		: NOVALUE,
	XRECALL		: NOVALUE,
	XRESET		: NOVALUE,
	XRESIGNAL	: NOVALUE,
	XRESUME		: NOVALUE,
	XRETURN		: NOVALUE,
	XSAVE		: NOVALUE,
	XSEARCH		: NOVALUE,
	XSET1		: NOVALUE,
	XSET2		: NOVALUE,
	XSET3		: NOVALUE,
	XSHIFT		: NOVALUE,
	XSIGNAL		: NOVALUE,
	XSTEP		: NOVALUE,
	XSTORE		: NOVALUE,
	XSTRACE		: NOVALUE,
	XSUBTRACT	: NOVALUE,
	XTIMES		: NOVALUE,
	XTRACE		: NOVALUE,
	XWATCH		: NOVALUE,
	XWBASE		: NOVALUE,
	XWHERE		: NOVALUE;
! Character codes

LITERAL
	TAB=		 %O'11',
	LF=		 %O'12',
	CR=		 %O'15',
	ESCAPE=		 %O'33',
	DQUOTE=		 %O'42',		! "
	SQUOTE=		 %O'47',		! '
	LEFTPAREN=	 %O'50',		! (
	RPAREN=		 %O'51',		! )
	LPOINTY=	 %O'74',		! <
	RPOINTY=	 %O'76',		! >
	LSQUARE=	%O'133',		! [
	RSQUARE=	%O'135',		! ]
	LBRACE=		%O'173',		! {	! LG change
	BAR=		%O'174',		! |	subst for escape!
	RBRACE=		%O'175';		! }	! LG change
ROUTINE BEGINSIX12: NOVALUE=
!+
! FUNCTION
!	First code address within SIX12 debugger
!-
    BEGIN
    GLOBAL LITERAL
	SIXLSF=	-1,		! Delete local symbols 
	SIXPOL=	0,		! Default is terminal polling
	SIXSTF=	-1,		! Come up in SIX12
	SIXENF=	-1;		! DEBUG UUO's will be honored, not JFCL-ed
    0
    END;
ROUTINE STOPIT: NOVALUE=
    BEGIN
    SETON(ENABFLAG);
    IF ISON(TRACEFLAG) THEN INCRTOG;
    LPTOFF();
    GOFLAG = 2;				! Indicates prompt for more commands
    SETOFF(WHACKING)
    END;
! Declarations for UUO entry to SIX12
! -----------------------------------

LITERAL
	DEBUGUUO=%O'037',
	TBLPOS=24,		! This bit is DEBUG 2,rtn or DEBUG 3,rtn
				! and indicates the routine is "interesting"
	EXITPOS=23,		! This bit means it is DEBUG 1,rtn
	NOVALUEPOS=25,		! Means the routine (Bliss-36) is
				! a NoValue routine (DEBUG 5,rtn or
				! DEBUG 15,rtn)
	UNWINDPOS=26;		! The special DEBUG after a stack unwind
				! (DEBUG 11,rtn or DEBUG 15,rtn)

MACRO
	TBLBIT=BITFIELD(TBLPOS) %,
	EXITBIT=BITFIELD(EXITPOS) %,
	NOVALUEBIT=BITFIELD(NOVALUEPOS) %,
	UNWINDBIT=BITFIELD(UNWINDPOS) %,

	ISINTBL=.$JBUUO<TBLBIT> %,
	ISEXIT=.$JBUUO<EXITBIT> %,
	ISNOVALUE=.$JBUUO<NOVALUEBIT> %,
	ISUNWOUND=.$JBUUO<UNWINDBIT> %,

	CHKUWP(ACTION,ADDRESS)=
	    BEGIN
%IF TOPS10
%THEN
	    REGISTER
		RUWP;

	    RUWP = 0;
	    SETUWP(RUWP);		! Clear and save previous protection
	    (ACTION);
	    SETUWP(RUWP);		! Restore to previous state
%ELSE
	    IF NOT ISWRITABLE(ADDRESS)
	    THEN
		SPACS( $FHSLF^18 +			! This process,
		    (((ADDRESS) AND %O'777777') ^ (-9)),! specific page
		      PA_CPY);				! Copy on write

	    IF ISWRITABLE(ADDRESS) THEN (ACTION)
%FI
	    END %;
! TTY and LPT I/O support
! -----------------------

! Items beginning with 'TT' always write to the TTY.  They
! will also write to LPT in LPTDUP mode.   Others
! write either to TTY or LPT-FILE, or both, depending on state of
! switch 'LPTFlag'  (set by LPTON, LPTDUP, and LPToff). Routines
! OpenLPT and CloseLPT must be called before and after one
! complete set of LPT output.

BIND
	CRLFSTR=CH$PTR(UPLIT (%ASCIZ %STRING(%CHAR(13,10)))),	! STRING FOR CRLF Macro
	VALSTR=CH$PTR(UPLIT (%ASCIZ %STRING(%CHAR(9),'Value: '))): VECTOR;		! FOR OUTVALUE

MACRO
	MSG[]= CH$PTR( UPLIT (%ASCIZ %STRING(%REMAINING) ) ) %,

 	INC=
	    %IF TOPS10
	    %THEN
		BEGIN
		REGISTER
		    C;
		INCHWL(C);
		.C
		END
	    %FI %,

	OUTS[]=	OUTSA( MSG(%REMAINING) ) %,

	TTOUTS[]=	TTOUTSA( MSG(%REMAINING) ) %,

	TTOUTSH(Z)=
	    BEGIN
%IF TOPS10
%THEN
	    OUTSTR(Z);
%ELSE
	    PSOUT( Z )
%FI
	    END %,

	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)) %,
	TTOUTDEC(N)=
	    TTOUTN(N,10,1) %,
	CRLF=
	    OUTCRLF() %,
	TTCRLF=
	    BEGIN
		TTOUTSA(CRLFSTR)
	    END %,
	PUTTAB=
	    OUTC(TAB) %,
	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)) %;
ROUTINE OUTFLAGRTN : NOVALUE=
    BEGIN
    CASE .RTNLVL FROM 0 TO 1 OF
	SET
	[0]:    OUTS('B:');
	[1]:    OUTS('A:');
	[OUTRANGE]:	0	! Routine level can be -1 (which would loop)
	TES;
    END;
ROUTINE OUTCRLF : NOVALUE = OUTSA(CRLFSTR);	! OUTPUT NEWLINE

ROUTINE DBLEQL: NOVALUE = OUTS('  ==  ');	! Output equivalency symbols
! SUPPORT of LPT and SAVE/LOAD I/O
! --------------------------------

LITERAL
	SLCHN=%O'16',
	LPTCHN=%O'17';

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

MACRO
	ANYLPT(DUMMY) = BEGIN .LPTFLAG NEQ 0 END %,
	NOLPT(DUMMY) = BEGIN .LPTFLAG EQL 0 END %,
	LPTDUPPING(DUMMY) = BEGIN .LPTFLAG GTR 0 END %,
	ANYTERMINALOUTPUT(DUMMY) = BEGIN .LPTFLAG GEQ 0 END %,
	LPTOUTTING(DUMMY) = BEGIN .LPTFLAG LSS 0 END %;
ROUTINE OPENLPT : NOVALUE=
!+
! FUNCTION
!	Set up for copying output to hard-copy
!-
    BEGIN
%IF TOPS10
%THEN
    LOCAL
	SAVFF,
	OPENBLOCK:	VECTOR[4],
	BLOCK:		VECTOR[4];

    STATUS = 1;
    LDEV = %SIXBIT 'SIX12';
    BUFW = LPTHDR^18;
    IF NOT OPEN(LPTCHN,OPENBLOCK)
    THEN
	BEGIN
	LDEV = %SIXBIT 'LPT';
	IF NOT OPEN(LPTCHN,OPENBLOCK)
	THEN
	    RETURN ERROR(10)
	END;

    FNAME = %SIXBIT 'SIX12';
    FEXT = %SIXBIT 'LPT';
    JUNK = 0;
    PPN = 0;

    IF NOT ENTER(LPTCHN,BLOCK) THEN RETURN ERROR(10);

    SAVFF = .$JBFF;
    $JBFF = LPTBUF;
    OUTBUF(LPTCHN,1);
    $JBFF = .SAVFF;
    OUT(LPTCHN,0);
%ELSE
    LOCAL
	JFN;

    IF GTJFN( GJ_FOU+GJ_NEW+GJ_SHT,		! New output file, short form
		  MSG('SIX12:')                 ! file spec, first try
		; JFN ) OR                      ! Returned JFN
       GTJFN( GJ_FOU+GJ_NEW+GJ_SHT,             ! Second, try for "real" LPT
                  MSG('LPT:SIX12.LPT')          !  and random filespec
                ; JFN )
    THEN
	BEGIN
	LPTHDR = .JFN<RH>;				! SAVE JFN

	IF NOT OPENF( .JFN, (7^30)+OF_WR )		! 7-bit bytes, write access
	THEN
	    RETURN ERROR(10)
	END
    ELSE
	RETURN ERROR(10);
%FI

    SETON(LPTOPENFLAG)				! Set line printer file open
    END;
ROUTINE LPTOUT(CHAR): NOVALUE=
    BEGIN
    IF NOLPT() THEN RETURN;

%IF TOPS10
%THEN
    IF (LPTCNT = .LPTCNT-1) LEQ 0 THEN OUT(LPTCHN,0);
    CH$WCHAR_A( .CHAR, LPTPTR )
%ELSE
    BOUT(.LPTHDR, .CHAR)
%FI
END;
ROUTINE OUTC(CHAR): NOVALUE=
!+
! FUNCTION
!	Output single character to all relevant output devices
!
! INPUTS
!	CHAR	- 7-bit ASCII character (right-justified)
!-
    BEGIN
    IF ISON(DISKOFLAG) THEN RETURN(OUTWORD(.CHAR));
    IF ANYTERMINALOUTPUT() 
    THEN
%IF TOPS10
%THEN
	OUTCHR(CHAR);
%ELSE
	PBOUT( .CHAR );
%FI

    IF ANYLPT() THEN LPTOUT(.CHAR)

    END;

GLOBAL BIND SIXOCH=OUTC;
ROUTINE OUTSA(STR) : NOVALUE=
!+
! INPUTS
!	STR	- CH$PTR to an ASCIZ string to be printed
!-
    BEGIN
    IF ISON(DISKOFLAG)
    THEN
	BEGIN
	LOCAL
	    PTR;
	REGISTER
	    C;

	PTR = .STR;

	WHILE (C=CH$RCHAR_A(PTR)) NEQ 0 DO OUTC(.C);
	RETURN
	END;

    IF ANYTERMINALOUTPUT()
    THEN
	BEGIN
%IF TOPS10
%THEN
	IBP( STR );
	OUTSTR(.STR<RH>)
%ELSE
	PSOUT( .STR )
%FI
	END;

    IF ANYLPT()
    THEN
	BEGIN
%IF TOPS10
%THEN
	REGISTER
	    PTR,
	    C;

	PTR = .STR;
	WHILE (C = CH$RCHAR_A(PTR)) NEQ 0 DO
	    BEGIN
	    IF (LPTCNT = .LPTCNT-1) LEQ 0 THEN OUT(LPTCHN,0);
	    CH$WCHAR_A(.C, LPTPTR)
	    END
%ELSE
	SOUT( .LPTHDR, .STR, 0 )
%FI
	END
    END;
GLOBAL ROUTINE SIXOSA(P)=
!+
! FUNCTION
!	Print string addressed by P, if it is accessible.
! INPUT
!	P	- Byte-pointer to a string
! OUTPUTS
!	TRUE	- Addressable value
!	FALSE	- Bad address
!-
    BEGIN
    IF ISREADABLE(.P<RH>)
    THEN
	BEGIN
	OUTSA(.P);
	RETURN 1
	END
    ELSE
	RETURN 0
    END;
ROUTINE INWORD=
!+
! FUNCTION
!	Fetch next word from SAVE/LOAD channel or when reading an
!	indirect command file (RESTORE command)
! INPUTS
!	None
! OUTPUTS
!	-1	EOF encountered on input
!	Other	Data value
!-
    BEGIN
    IF ISON(ERRORFLAG) THEN RETURN -1;

%IF TOPS10
%THEN
    IF (DSKCNT = .DSKCNT-1) LEQ 0
    THEN
	IF IN(SLCHN,0)
	THEN				! An I/O error occurred
	    BEGIN
	    IF STATZ(SLCHN,IO$EOF)
	    THEN			! Was NOT EOF, so must have been
		SETON(ERRORFLAG);  	!  for real.  Flag this as "BAD"
	    RETURN -1			! Return all errors as EOF
	    END;
    RETURN CH$RCHAR_A( DSKPTR )
%ELSE
    BEGIN
    LOCAL
	RESLT;

    IF BIN( .DSKHDR ; RESLT )
    THEN
	RETURN .RESLT;			! Return word read in

    -1					! ERROR ----
    END
%FI
    END;
ROUTINE INCHARS=
!+
! Return next "real" character from input disk file
!-
    BEGIN
    LOCAL
	C;

    DO
	BEGIN
	C = INWORD();
	IF CH$RCHAR(.DSKPTR)		! Low bit says line-sequenced
	THEN
	    DECR I FROM 5 TO 0 DO C = INWORD();	! skip line no.
	END
    UNTIL .C NEQ 0;

    .C
    END;
ROUTINE OUTFD(VALUE,WID): NOVALUE=
    BEGIN
    IF .IOBASE EQL 8 AND ABS(.VALUE) GTR 7 THEN OUTC(%C'#');
    OUTDR(.VALUE,.WID)
    END;
ROUTINE OUTWORD(WRD):NOVALUE=
!+
! FUNCTION
!	Write a word to the disk output
!-
    BEGIN
    IF ISON(ERRORFLAG) THEN RETURN;

%IF TOPS10
%THEN
    IF (DSKCNT = .DSKCNT-1) LEQ 0		! When the ring-buffer is full
    THEN					!  write it out to the device
	IF OUT(SLCHN,0)
	THEN
	    (SETON(ERRORFLAG);  RETURN );

    CH$WCHAR_A(.WRD, DSKPTR)
%FI

%IF TOPS20
%THEN
    BOUT( .DSKHDR, .WRD )
%FI
    END;
ROUTINE CLOSELPT: NOVALUE=
    BEGIN
    LPTFLAG = 0;

%IF TOPS10
%THEN
    CLOSE(LPTCHN,0);
    RELEASE(LPTCHN,0);
%FI

%IF TOPS20
%THEN
    CLOSF( .LPTHDR );
%FI
    SETOFF(LPTOPENFLAG)
    END;
ROUTINE LPTON:NOVALUE= IF ISON(LPTOPENFLAG) THEN LPTFLAG = -1 ELSE ERROR(19);

ROUTINE LPTDUP:NOVALUE= IF ISON(LPTOPENFLAG) THEN LPTFLAG =  1 ELSE ERROR(19);

ROUTINE LPTOFF:NOVALUE= LPTFLAG = 0;
ROUTINE XRESET: NOVALUE=
    BEGIN
    IF ISON(LPTOPENFLAG) THEN RETURN ERROR(20);

%IF TOPS10 %THEN CALLI(0,0) %FI

%IF TOPS20 %THEN RESET() %FI

    END;
! General purpose number output Routine
! -------------------------------------

ROUTINE OUTN(N,B,RD)=
! Returns the number of positions printed
    BEGIN
    OWN
	NUM,
	NUMNP,
	BASE,
	REQD,
	WRIT,
	COUNT;

    ROUTINE XN:NOVALUE=
	BEGIN
	REGISTER
	    R;
	IF .NUM EQL 0
	THEN
	    BEGIN
	    OUTM(%C' ',WRIT = .REQD-.COUNT);
	    IF ISON(NUMNP) THEN (OUTC(%C'-'); WRIT = .WRIT + 1);
	    RETURN
	    END;
	R = .NUM MOD .BASE;
	NUM = .NUM/.BASE;
	COUNT = .COUNT+1;
	XN();
	OUTC(R = .R+%C'0');
	WRIT = .WRIT + 1
	END;

    NUMNP = COUNT = (.N LSS 0);
    BASE = .B;
    REQD = .RD;
    WRIT = 0;

    IF (NUM = ABS(.N) AND NOT 1^35) NEQ 0 THEN RETURN (XN(); .WRIT);

    OUTM(%C' ',.REQD-1-.NUMNP);
    IF .NUMNP NEQ 0 THEN OUTC(%C'-');
    OUTC(%C'0');
    .REQD    
    END;
ROUTINE TTOUTN(B,D,R):NOVALUE=
    BEGIN
    LOCAL
	OLDLPT;

    OLDLPT=.LPTFLAG;
    LPTOFF();
    OUTN(.B,.D,.R);
    LPTFLAG = .OLDLPT
    END;
ROUTINE TTOUTC(CH): NOVALUE=
!+
! FUNCTION
!	Write a single character to the terminal, duplicating (if necessary)
!	into the "log" file.
! INPUTS
!	CH	- The ASCII character value to print
! OUTPUTS
!	None
!-
    BEGIN
    IF LPTDUPPING() THEN LPTOUT(.CH);
%IF TOPS10
%THEN
    OUTCHR( CH )
%ELSE
    PBOUT( .CH )
%FI
    END;
ROUTINE TTOUTSA(STR): NOVALUE=
    BEGIN
    IF LPTDUPPING() THEN RETURN OUTSA(.STR);
    TTOUTSH(.STR<RH>+1)
    END;
ROUTINE OUTVALUE(X): NOVALUE=
!+
! FUNCTION
!	Print routine return value.  Use user-supplied routine, if
!	it is present.
! INPUT
!	X	- The value passed back from a ABREAK-ed or TRACE-d routine
!-
    BEGIN
    OUTSA(VALSTR);
    IF .SIXHDR NEQ 0
    THEN			! A user-written routine is present.
	BEGIN %(user routine)%
	LOCAL
	    OLDRNAME;

	OLDRNAME = .RNAME;
	INSIXHDR=1;

	IF (.SIXHDR)(.RNAME,F50TO6(.SDDTFS(.RNAME)),X,1,0)
	THEN
	    BEGIN
	    INSIXHDR=0;
	    RNAME = .OLDRNAME;
	    CRLF;
	    RETURN
	    END;

	INSIXHDR=0;
	RNAME = .OLDRNAME
	END %(user routine)%;

    OUTDEFAULT(.X);
    DBLEQL();
    PRDISP(.X);
    CRLF
    END;
ROUTINE SHOWNOVALUE: NOVALUE=
	BEGIN
	OUTS(' :NoValue');
	CRLF
	END;
ROUTINE ISHIGHSYMBOLTABLE=
!+
! FUNCTION
!	Returns "true" if there is a separate hiseg symbol table, false
!	if only one symbol table.
!-
    BEGIN
    ! if the symbol ".JBHGH+.JBHSM" is not defined, there isn't even a hiseg:
    !

    IF .IJOBHSM EQL 0 THEN RETURN 0;

    ! there may be a hiseg, but it may be absent:
    !

    IF NOT ISREADABLE(.IJOBHSM) THEN RETURN 0;

    ! if HCache is nonzero, we have already set it up on this SIX12 entry
    ! since HCache is reset on every SIX12 entry or return from a user
    ! procedure (since the user can obviously do a call to switch segments)
    ! we know it must be valid
    !

    IF .HCACHE NEQ 0 THEN RETURN 1;

    IF .(.IJOBHSM) NEQ 0 AND .(.IJOBHSM) NEQ .$JBSYM
    THEN
	BEGIN					%(have two)%
	HSYM = 1;
	HCACHE = .(.IJOBHSM);
	RETURN 1
	END;

    RETURN 0       
    END;
ROUTINE NSDDTW(X,V,SYM: MODULEPTR)=
!+
! FUNCTION
!	Given a symbol search for the address of its next occurrence in
!	table SYM
! INPUTS
!	X	- RAD50_10 value of symbol to look up
!	V	- If non-zero, where to start looking in the symbol table
!	SYM	- If V is zero, the address of a symbol-table to look in
! OUTPUT
!	<cnt,,adr> of found symbol
!-
    BEGIN
    LOCAL
	R	: SYMBOL;

    IF .V EQL 0
    THEN
	BEGIN
	R = - .SYM[MODSYMCNT];			! Symboltable count
	R = .R^18 + .R + .SYM[MODSYMPTR];	! Compute "end" address
	END
    ELSE
	R = .V;

    ! Walk backwards thru the symbol-table looking for a name-match
    !

    WHILE (R = .R-%O'2000002') GEQ 0 DO
	IF .R[RAD50NAME] EQL .X THEN RETURN .R;		! Found it

    0
    END;
ROUTINE NSDDTFA(X,V)=
!+
! FUNCTION
!	Given a symbol, search for the address of its next occurrence
!	First use .JBHSM, then .JBSYM; this means that we always check
!	the overlay first.  If .JBHSM is zero or the same as .JBSYM,
!	use only .JBSYM
! INPUT
!	X	- RAD50 Symbol name to look up
!	V	- If non-zero, where to begin searching
!-
    BEGIN
    LOCAL
	T	: SYMBOL;

    IF NOT ISHIGHSYMBOLTABLE()
    THEN
	RETURN NSDDTW(.X,.V,.$JBSYM);

    IF (T =NSDDTW(.X,.V,.HCACHE)) EQL 0 
    THEN
	NSDDTW(.X,.V,.$JBSYM)
    ELSE
	.T
    END;
!	Routine SDDTFA(X) =
!	    ! Given a symbol, search ddt symbol-table for its value
!	    ! return the value
!	    begin
!	    Register R;
!	    If (R = NSDDTFA(.X,0)) neq 0 then Return @(.R+1);
!	    Error(0)
!	    end;
ROUTINE FINDMODULE(X)=
!+
! FUNCTION
!	Returns a pointer to the module which can be passed to
!	NSDDTFA and which restricts the search to that module
!	This is used for qualified-name search algorithm
! INPUT
!	X	- RADIX50 name of module
! OUTPUT
!	0 => no such module
!	cnt,,start of module symbol table
!-
    BEGIN
    LOCAL
	S	: SYMBOL,
	MODPTR;

    S = NSDDTFA(.X,0);				! Search entire DDT symboltable
						!  for particular module name

    IF .S EQL 0 THEN RETURN 0;			! module not found!

    MODPTR<RH> = .S;				! Starting address of module
						!  symbol table
    MODPTR<LH> = - .S[SYMBOLCNT];		! # of symbols in module

    .MODPTR
    END;
ROUTINE HSDDTFS (X, SYM : SYMBOL)=
!+
! FUNCTION
!	Given an address, search table for the symbol most nearly matching it
! INPUT
!	X	- a value (address) whose symbol is to be searched for
!	SYM	- Symbol table to search
! OUTPUT
!	A pointer to the DDT symbol table entry for the symbol found
!-
    BEGIN
    LOCAL
	R	: SYMBOL,
	BEST	: SYMBOL;

    BIND
	DMY=UPLIT(0,0);			! Dummy ste for "no-match"

    BEST = DMY;				! Assume no match found

    R = - .SYM<LH,1>;
    R = .R^18 + .R + .SYM<RH>;

    WHILE (R = .R-%O'2000002') GEQ 0 DO
	IF NOT .R[INVALIDFLAG]			! Symbol not deleted...
	THEN
	    SELECTONE .R[VALUEWRD] OF
		SET
		[.X]:				RETURN .R<RH>;	! Exact match
		[.BEST[VALUEWRD] TO .X]:	BEST = .R<RH>	! Better match
		TES;

    .BEST
    END;
ROUTINE SDDTFS(X)=
!+
! FUNCTION
!	Search symbol-tables for a symbolic name, given a value.  Follows
!	the same "rules" as NSDDTFA, by first looking for a HISEG symbol
!	table and then searching the LOWSEG symbol-table.
! INPUTS
!	X	- Numeric value
! OUTPUTS
!	Address of symbol-table entry or ZERO
!-
    BEGIN
    LOCAL
	T;

    IF NOT ISHIGHSYMBOLTABLE()
    THEN
	RETURN HSDDTFS(.X,.$JBSYM);

    IF (T=HSDDTFS(.X,.HCACHE)) EQL 0 
    THEN
	HSDDTFS(.X,.$JBSYM)
    ELSE
	.T
    END;
ROUTINE KILLSYMBOL(SYMREF: SYMBOL):NOVALUE=
!+
! FUNCTION
!	SymRef is a modified symbol table pointer, where the RH is the address
!	of the symbol to be deleted, and the LH is the count of symbols
!	left (including the one to be deleted)
! INPUTS
!	SYMREF	- Symbol table pointer (LH is special)
!-
    BEGIN

    !+
    ! Mark the symbol as a suppressed local with an "illegal" name
    ! to keep it from matching with any interesting symbols.
    !-
    SYMREF[NAMEWRD] = 1^35 + DDT$_OWN^32 + (%RAD50_10 '%%%%%%'+1);
    SYMREF[VALUEWRD] = -1
    END;
ROUTINE DSIXSYMS(SYM):NOVALUE=
!+
! FUNCTION
!	Delete SIX36's local symbols from DDT symbol table(s)
!-
    BEGIN
    LOCAL
	R	: SYMBOL;
    BIND
	SIXMODNAME = %RAD50_10 'SIX36';

    R = -.SYM<LH,1>;
    R = .R^18 + .R + .SYM<RH>;

    WHILE (R = .R - %O'2000002') GEQ 0 DO		! Find SIX36 module
	BEGIN
	IF .R[RAD50FLAG] EQL DDT$_MODULE AND .R[RAD50NAME] EQL SIXMODNAME
	THEN
	    EXITLOOP
	END;

    WHILE (R = .R - %O'2000002') GEQ 0 DO		! DELETE LOCALS
	BEGIN
	IF .R[RAD50FLAG] EQL DDT$_MODULE THEN EXITLOOP;	! Next MODULE
	IF .R[RAD50FLAG] EQL DDT$_OWN			! Local
	    AND .R[RAD50NAME] NEQ %RAD50_10 'STARTF'
	    AND .R[RAD50NAME] NEQ %RAD50_10 'ENABFL'
	    AND .R[RAD50NAME] NEQ %RAD50_10 'NOPOLL'
	THEN
	    KILLSYMBOL(.R)
	END
    END;
ROUTINE NOSIXSYMS: NOVALUE=
    BEGIN
    IF ISHIGHSYMBOLTABLE()
    THEN
	DSIXSYMS(.HCACHE);
    DSIXSYMS(.$JBSYM)
    END;
ROUTINE FNDDBGUUO(STRT,ISITEXIT)=
!+
! FUNCTION
!	Starting at given address (STRT), scan forward looking
!	for DEBUG UUO.
! INPUTS
!	STRT	- Starting address
!	ISITEXIT- Are we looking for routine-entry or exit UUO?
! OUTPUTS
!	-1	No DEBUG UUO could be found
!	0:...	Address of the DEBUG UUO found
!-
    BEGIN
    LOCAL
	CORELIM,
	MATCH;
    BIND
	BITS = %O'777000777777' OR 1^EXITPOS;

    MATCH = DEBUGUUO^27 OR .ISITEXIT^EXITPOS OR .STRT<RH>;

    IF	.STRT<RH> GEQ $JBDA AND
	.STRT<RH> LEQ .$JBREL<RH>
    THEN
	CORELIM = .$JBREL<RH>
    ELSE
	IF .STRT<RH> GEQ ((.$JBHRL<RH>-.$JBHRL<LH>) AND %O'777000') AND
	    .STRT<RH> LEQ .$JBHRL<RH>
	THEN
	    CORELIM = .$JBHRL<RH>
	ELSE
	    RETURN -1;

    INCRA J FROM .STRT<RH> TO .CORELIM DO
	IF (..J AND BITS) EQL .MATCH
	THEN
	    RETURN .J;
    -1
    END;
ROUTINE HMODNAME(X, SYM: SYMBOL)=
!+
! FUNCTION
!	Given a start address X (in DDT symbol table), finds entry for
!	a module name
! INPUT
!	X	- DDT Symbol Table Entry
!	SYM	- Pointer to module record in DDT Symbol Table
!-
    BEGIN
    REGISTER
	R	: SYMBOL;

    R = .X + (.SYM<LH>^18);

    WHILE (R = .R+%O'2000002') LSS 0 DO
	IF  .R[RAD50FLAG] EQL DDT$_MODULE AND	! Seek a module definition
	    .R[NAMEWRD] NEQ %O'637777'^18	! Don't stop on deleted symbol
	THEN
	    RETURN .R<RH>;

    0						! No module
    END;
ROUTINE MODNAME(X)=
    BEGIN
    IF ISHIGHSYMBOLTABLE() AND .X<RH> GEQ .HCACHE<RH> 
    THEN 
	HMODNAME(.X,.HCACHE)
    ELSE
	HMODNAME(.X,.$JBSYM)
    END;
ROUTINE MODDDT(X)=
!+
! FUNCTION
!	Given a start address X in DDT symbol table, returns
!	Radix50 Module name
!-
    BEGIN
    LOCAL
	R	: SYMBOL;

    R = MODNAME(.X);			! Do the lookup

    IF .R EQL 0 THEN RETURN .R;		! Not found, return null string

    .R[RAD50NAME]			! Give back a good name
    END;
ROUTINE F50TO7(X)=
!+
! FUNCTION
!	Convert base 50 character to Ascii character
!-
    BEGIN
    SELECTONE .X OF
	SET
	[0]:		0;		! Blank
	[0 TO %o'12']:	.X + %o'57';	! "0".."9"
	[0 TO %o'44']:	.X + %o'66';	! "A".."Z"
	[%o'45']:	%C'.';		! period
	[%o'47']:	%C'_';		! % or "_"
	[%o'46']:	%C'$';		! "$"
	TES
    END;
ROUTINE F50TO6(X)=
!+
! FUNCTION
!	convert Base 50 symbol to SIXBIT symbol
!-
    BEGIN
    LOCAL
	R,
	OLD;

    R = 0;

    WHILE .X NEQ 0 DO
	BEGIN
	OLD = .X MOD %O'50';
	X = .X / %O'50';
	R = .R + (F50TO7(.OLD)-%O'40');
	R = ROT(.R, -6)
	END;
    .R
    END;
ROUTINE F7TO50(X)=
!+
! FUNCTION
!	Convert ASCII character to RAD50_10 character
    BEGIN
    SELECTONE .X OF
	SET
	[0]:			0;		! Ignore
	[%C'.', %C'&']:		%O'45';		! Map to same code
	[%C'$']:		%O'46';		!
	[%C'_', %C'%']:		%O'47';		!  "   "   "    "
	[%C'0' TO %C'9']:	.X - %O'57';
	[%C'A' TO %C'Z']:	.X - %O'66';
	[OTHERWISE]:		.X - %O'126';	! Lower-case alphabetics
	TES
    END;
ROUTINE PRQ50(X)=
BEGIN
	
    ROUTINE PRQA50 (X : BLOCK FIELD(DDT_FIELDS), F)=
	BEGIN
	LOCAL
	    R;

	IF (X = .X[RAD50NAME]) NEQ 0
	    THEN
		BEGIN
		R = .X MOD %O'50';
		F = .F OR (.R EQL %RAD50_10 '.');
		F = PRQA50(.X/%O'50',.F);
		OUTC(F50TO7(.R));
		RETURN .F
		END
	    ELSE
		BEGIN
		IF .F THEN OUTC(%C'?');
		RETURN .F
		END;
	END;
	
    PRQA50(.X,0)
END;
ROUTINE PRSYM50(X)=
    ! PRINT NAME GIVEN IN BASE 50
    ! Returns the number of characters printed
    BEGIN
    ROUTINE PSYM5 (X : BLOCK FIELD(DDT_FIELDS), Y)=
	BEGIN
	LOCAL
	    VAL,
	    R;

	IF (VAL = .X[RAD50NAME]) NEQ 0
	THEN
	    BEGIN
	    LOCAL
		V;
	    R = .VAL MOD %O'50';
	    V = PSYM5(.VAL/%O'50',.Y+1);
	    OUTC(F50TO7(.R));
	    RETURN .V
	    END;
	.Y
	END;
    PSYM5(.X,0)
    END;
ROUTINE PRSYM6(X)=
!+
! FUNCTION
!	Print a SIXBIT symbolic value
! INPUTS
!	X	- SIXBIT value
! OUTPUT
!	Returns the number of characters actually printed
!-
    BEGIN
    LOCAL
	P,
	C,
	V;

    V = 0;
    P = CH$PTR( X, 0, 6 );		! SIXBIT string pointer

    WHILE (C = CH$RCHAR_A(P)) NEQ 0 DO
	BEGIN
	V = .V + 1;
	OUTC(.C+%O'40');
	IF .V EQL 6 THEN EXITLOOP	! Certainly no more than 6 chars
	END;
    .V
    END;
ROUTINE PROP(X):NOVALUE=
!+
! FUNCTION
!	Print an operator from the table. Operators come in two flavors,
!	SIXBIT (left-justified) and 1-character ASCII (stored in <18,7>)
! INPUT
!	X	- "print-name" of operator.
!-
    BEGIN
    IF (.X AND %O'777600777777') EQL 0
    THEN
	OUTC(.X<LH>)
    ELSE
	PRSYM6(.X)
    END;
ROUTINE PRDISP(X):NOVALUE=
!+
! FUNCTION
!	Print both halves of .X in "BASE+DISP" form
!-
    BEGIN
    LOCAL
	BP	: $BYTE_POINTER;
    LABEL
	LB;
    BIND
	FWPTR = POINT(0, FW) ^(-18) AND %O'777777',
	LHPTR =	POINT(0,LH) ^(-18) AND %O'777777',
	RHPTR = POINT(0, RH) ^(-18) AND %O'777777';

    ! Check to see if value looks like a byte-pointer, in which case it
    ! will have position,size in LH.
    !

    BP = (IF .X<LH> EQL LHPTR
	 OR .X<LH> EQL FWPTR
	 OR .X<LH> EQL RHPTR
	 OR .X<24,6> EQL 7		! Char string?
	 OR .X<24,6> EQL 8		! Bliss-16 likes 8-bit bytes
	 OR .X<24,6> EQL 9		! APLSF uses 9-bit bytes
	THEN
	    .X 
	ELSE
	    0);

    DECR I FROM 1 TO 0 DO
LB:	BEGIN
	LOCAL
	    Z;

	Z = ( IF .I THEN .X<LH> ELSE .X<RH> );

	IF .Z LSS $JBDA				! JOBDAT areas shouldn't be
	THEN					!  printed symbolically?
	    BEGIN
	    IF .I AND .Z EQL 0 THEN LEAVE LB;
	    OUTDEFAULT(.Z)
	    END
	ELSE
	    BEGIN
	    LOCAL
		L	: SYMBOL,
		M;

	    L = SDDTFS(.Z);
	    M = .Z-.L[VALUEWRD];
	    IF (.WDBASE GEQ 0) AND (.M GTR .WDBASE)	! Value is too far from
	    THEN					!  symbolic name to be
		OUTDEFAULT(.Z)				!  printed as B+offset
	    ELSE
		BEGIN
		LOCAL
		    Q,		! Qualification information
		    F;

		Q=GQUAL(.L,.L[VALUEWRD]);
		OUTQUAL(.Q,0,QUALPREFIX);
		F=PRQ50(.L[RAD50NAME]);
		OUTQUAL(.Q,.F,QUALSUFFIX);
		IF .M NEQ 0 THEN (OUTC(%C'+');  OUTDEFAULT(.M))
		END;
	    END;
	IF .I THEN OUTS(',,')
	END;

    IF .BP NEQ 0
    THEN
	BEGIN
	OUTC(%C'<');
	OUTFD(.BP[P_POS],0);
	OUTC(%C',');
	OUTFD(.BP[P_SIZE],0);
	OUTC(%C'>')
	END

    END;
ROUTINE PRXDISP(X): NOVALUE=
!+
! FUNCTION
!	Print only base of .X<RH>
! INPUTS
!	X	- Fullword with Effective address(?) in RH.
!-
    PRQUAL( .X<RH> , 0);
! Routines to parse and display the stack
!

MACRO
	WITHINSIX12(PC) =
		((PC) GTR BEGINSIX12 AND (PC) LSS ENDSIX12) %,

	WITHINSIGNALHANDLER(PC)=
		BEGIN
		(PC) GEQA SIGNA$ AND (PC) LSSA SIGND$
		END %;
ROUTINE OUTQUAL (Q : SYMBOL, F, CODE): NOVALUE=
!+
! FUNCTION
!	Output a (possibly) qualified name
! INPUTS
!	Q	- Qualifying name (DDT symbol table entry) or numeric value
!	F	- Formatting flag?
!	CODE	- Indicates prefix or postfix qualification
! OUTPUTS
!	None
!-
    BEGIN
    IF .CODE EQL QUALPREFIX
    THEN
	IF .Q EQL -1
	THEN
	    RETURN			! No qualification present
	ELSE
	    IF  .Q LSS 0
	    THEN
		BEGIN
		IF .Q<RH> NEQ .GQUALIFIER<RH> THEN PRQ50(.Q[RAD50NAME]);
		OUTC(%C'\');
		RETURN
		END
	    ELSE
		RETURN;

    IF .CODE EQL QUALSUFFIX AND .Q LSS 0 THEN RETURN;	! Ignorable %n suffix

    IF .F THEN OUTC(%C' ');
    OUTC(%C'%');
    OUTDEFAULT(.Q)
    END;
ROUTINE GQUAL(S: SYMBOL,V)=
!+
! FUNCTION
!	???
! Inputs:
!	S - Radix50 symbol
!	V - value of the symbol
!
!	Returns one of three conditions:
!	-1 => no qualification required
!	-1,,x => x is DDT symbol table address of module qualifier
!	n => %n qualification
!
!	Use is to call GQUAL to get qualification code, then
!	call OutQual, which decodes it.  OutQual also looks at
!	Qualifier to decide if name is to be printed at all
!-
    BEGIN
    LOCAL
	P	: SYMBOL,
	LJ,
	J,
	LP	: SYMBOL;

    P = 0;
    J = 0;

    WHILE 1 DO
	BEGIN						%(global search)%
	J = .J + 1;
	IF (P=NSDDTFA(.S[RAD50NAME],.P)) EQL 0
	THEN
	    BEGIN %(found all)%
	    ! if 0 on second try, symbol is unique
	    IF .J EQL 2 THEN EXITLOOP %(global search)%;
	    ! symbol is not unique if .J gtr 2
	    IF .J GTR 2 THEN
		BEGIN %(not unique so far)%
		LOCAL
		    P1	: SYMBOL,
		    MN	: SYMBOL;

		MN = MODNAME(.LP);
		P1 = (-.MN[SYMBOLCNT] ^18) OR .MN<RH>;

		INCR K FROM 1 DO
		    BEGIN			%(see if unique in module)%
		    IF (P1=NSDDTFA(.S[RAD50NAME],.P1)) EQL 0
		    THEN
			BEGIN %(local failure)%
			! if local failure on second try,
			! module qualification makes it unique
			IF .K EQL 2 THEN RETURN -1^18 OR .MN;
			IF .K GTR 2 THEN EXITLOOP %(see if unique in module)%;
			END %(local failure)%;
		    END %(see if unique in module)%;
		END %(not unique so far)%;
		! if we get here,the local search was also
		! ambiguous, so we return the numeric qualifier
		RETURN .LJ;
	    END %(found all)%
	ELSE
	    BEGIN %(found it)%
	    ! is this symbol the value we want?
	    !
	    IF .P[RAD50FLAG] EQL DDT$_MODULE
	    THEN
		J = .J - 1
	    ELSE
		IF .P[SYMBOLVAL] EQL .V<RH>
		THEN
		    BEGIN %(right value)%
		    LJ = .J;
		    LP = .P
		    END %(right value)%
	    END %(found it)%
	END %(global search)%;

    RETURN -1
    END %(gqual)%;
ROUTINE PRQUAL(X,DISP):NOVALUE=
!+
! FUNCTION
!	Given an address X, print out the symbol which matches it
!	and add qualification if the name is not unique
!-
    BEGIN

    LOCAL
	S	: SYMBOL,
	P,
	D,
	V,
	F;

    IF .X<RH> LSS $JBDA
    THEN
	BEGIN
	OUTDEFAULT(.X<RH>);
	RETURN
	END;

    S = SDDTFS(.X<RH>);
    D = (IF .DISP THEN .X<RH>-.S[VALUEWRD] ELSE 0);	! compute displacement

    V = .S[VALUEWRD];				! symbol value we are using
    P = GQUAL(.S,.V);
    OUTQUAL(.P,0,QUALPREFIX);
    F = PRQ50(.S[RAD50NAME]);



    OUTQUAL(.P,.F,QUALSUFFIX);
    IF .D NEQ 0 THEN 
	BEGIN
	OUTC(%C'+');
	OUTDEFAULT(.D)
	END;
    END;
GLOBAL ROUTINE SIXDPY(A):NOVALUE=
    BEGIN
    PRQUAL(.A<RH>,1)
    END;
ROUTINE PRQUALBP(ENTRY:$BYTE_POINTER):NOVALUE=
!+
! FUNCTION
!	Print byte pointer for saving MONITOR location
! INPUTS
!	ENTRY	- Hardware Byte-pointer
!-
    BEGIN
    LOCAL
	T	: $BYTE_POINTER,
	D	: SYMBOL;

    D = SDDTFS(.ENTRY[P_OFFSET]);

    D = (.ENTRY[P_OFFSET] -.D[VALUEWRD] NEQ 0) AND .ENTRY[P_POS_SIZE] NEQ 0;
    IF .D  THEN OUTC(%C'(');
    PRQUAL(.ENTRY[P_OFFSET], 1);		! PRINT NAME
    IF .D  THEN OUTC(%C')');
    IF .ENTRY[P_POS_SIZE] NEQ %BPVAL		! Non-fullword pointers are
    THEN					!  to be qualified
	BEGIN			! PRINT <P,S>
	OUTC(%C'<');
	OUTFD(.ENTRY[P_POS],0);
	OUTC(%C',');
	OUTFD(.ENTRY[P_SIZE],0);
	IF .ENTRY[P_INDEX] NEQ 0
	THEN
	    BEGIN
	    OUTC(%C',');  OUTFD(.ENTRY[P_INDEX],0);
	    OUTC(%C',');   OUTD(.ENTRY[P_INDIRECT]);
	    END;
	OUTC(%C'>');
	END;
    END;
%SBTTL 'Stack-frame, argument-list processing'

FIELD
    FRAME_FIELDS=
	SET
	NEXT_FRAME=	[0, 0,18,0],	! Pointer to caller's frame
	RET_ADDRESS=	[-1,0,18,0],	! Saved return PC
	ARGS_BASE=	[-1,0, 0,0],	! Just before last argument
	LOCALS_BASE=	[ 1,0, 0,0],	! Base of local storage
	ENABLE_CHAIN=	[ 1,0,36,0]	! Pointer to ENABLE block
	TES;

MACRO
    $FRAME = HBLOCK FIELD(FRAME_FIELDS) %,

    !+
    ! B36 argument lists are pushed left-to-right.  Thus the first formal is
    !  deepest on the stack.  For an argument list of size LIM, this macro
    !  provides a BLOCK field-value for the "N"th actual. (Arguments are
    !  numbered 1..LIM
    !-
    ARG_N_OF_M(N,LIM)= (-(LIM+1)) + N + %FIELDEXPAND(ARGS_BASE,0),0,36,0 %;

MAP
    ENTERPNT	: $FRAME;
ROUTINE GETARGBASE(F: $FRAME,N)=
!+
! FUNCTION
!	Return address of 1st actual-parameter in a frame.
! INPUTS
!	F	- Pointer to FRAME
!	N	- Number of actual parameters in the call
!		  which "entered" this frame
! OUTPUTS
!	return the address of the first actual parameter
!-
	F[ARG_N_OF_M(1,.N)];


ROUTINE GETCALLFROM(F: $FRAME)=
!+
! FUNCTION
!	Return address of caller of the frame
! INPUTS
!	F	- Procedure call frame address
! OUTPUTS
!	Address of a PUSHJ or PJSRT instruction
!-
    .F[RET_ADDRESS] - %UPVAL;
ROUTINE GETARGCNT(F:	$FRAME)=
!+
! FUNCTION
!	GET ARG COUNT of CURRENT CALL GIVEN FRAME POINTER
!-
    BEGIN
    LOCAL
	NP,
	INSTRPC	: REF $INSTRUCTION;

    INSTRPC = .F[RET_ADDRESS];

    WHILE .INSTRPC[M_LHALF] EQL JRSTOP^9 DO	! JRST 0,-
	INSTRPC = .INSTRPC[M_OFFSET];		! Follow cross-jumping chain

    NP = 0;

    IF .INSTRPC[M_LHALF] EQL (SUBOP^9 OR SREG^5)	! SUB
    THEN
	NP = ..INSTRPC[M_OFFSET] AND %O'777777'
    ELSE
	IF .INSTRPC[M_LHALF] EQL (ADJSPOP^9 OR SREG^5)	! ADJSP
    THEN
	NP = - .INSTRPC[M_IMMEDIATE];

    IF .NP LSS 0 THEN NP = 0;

    .NP
    END;
ROUTINE GETARGADR(N,FRAME: $FRAME)=
!+
! FUNCTION
!	Get address of the n'th argument of given frame.
!	If FRAME IS ZERO then USE CURRENT FRAME.
! INPUTS
!	N	- argument index
!	FRAME	- pointer to procedure frame
! OUTPUT
!	Returns address of stack location if found, or -1 if there is no
!	actual parameter.
!-
    BEGIN
    LOCAL
	ARGLIST	: REF VECTOR,
	F	: $FRAME,
	NA;

    IF .RTNLVL LSS 0 THEN RETURN -1;

    F = (IF .FRAME EQL 0 THEN .ENTERPNT[NEXT_FRAME] ELSE .FRAME<RH>);
    NA = GETARGCNT(.F);

    IF .N LSS 1 OR .N GTR .NA THEN RETURN -1;

    ARGLIST = GETARGBASE(.F,.NA);

    ARGLIST[.N-1]		! List is zero-origined, but arguments
    END;			!  are enumerated 1..N
ROUTINE GETLCLCNT(PREVF : $FRAME)=
!+
! FUNCTION
!	Get number of locals for stack frame before given frame.
! INPUT
!	PREVF	- Pointer to a stack frame
! OUTPUT
!	Count of local parameters
!-
    BEGIN
    LOCAL
	F	: $FRAME,
	NL;

    PREVF = .PREVF<RH>;				! Clean address-pointer
    F = .PREVF[NEXT_FRAME];			! ADDRESS of FRAME of INTEREST
    IF .F EQL 0 THEN RETURN 0;			!  This is root, can't help you

    IF .PREVF NEQ .ENTERPNT<RH>
    THEN
	BEGIN
	NL = .PREVF -.F -2;			! Distance between two frames
						!  is # of locals (approx),
						!  less saved FP and return PC
	NL = .NL - GETARGCNT(.PREVF)		! Exclude actual parameters to
	END					!  later routine.
    ELSE
	! This is frame which caused us to enter SIX12.  Thus, everything
	!  between .ENTERPNT and the "saved" value of SP is a local for
	!  this routine.
	!
	IF .ENTERSP<RH> GTR .ENTERPNT<RH>
	THEN
	    NL = .ENTERSP<RH> - .ENTERPNT<RH>
	ELSE
	    NL = 0;

    IF .NL LEQ 0 THEN RETURN 0;

    .NL
    END;
ROUTINE GETLCLADR(N, PREVF : $FRAME)=
!+
! FUNCTION
!	Get address of n'th Local of frame before PREVF
! INPUTS
!	N	- Index of LOCAL
!	PREVF	- Frame pointer
! OUTPUT
!	Address of the local or -1 if out of bounds.
!-
    BEGIN
    IF .RTNLVL LSS 0 THEN RETURN -1;

    IF .N LSS 1 THEN RETURN -1;				! Bad local#, too small

    IF .PREVF EQL 0
    THEN
	BEGIN						! Use current frame
	IF .N GTR GETLCLCNT(.ENTERPNT[NEXT_FRAME])
	THEN
	    RETURN -1;	! Too large...

	.ENTERPNT<RH> + .N
	END
    ELSE
	BEGIN
	IF .N GTR GETLCLCNT(.PREVF) THEN RETURN -1;
	.PREVF[NEXT_FRAME] + .N
	END
    END;
ROUTINE PRG(B: REF VECTOR,T): NOVALUE=
!+
! FUNCTION
!	Print a contiguous set of WORDS for stack display.
! INPUTS
!	B	- Pointer to vector of words
!	T	- Number of entries to print
!-
    INCR I FROM 0 TO .T-1 DO
	BEGIN 
	OUTDEFAULT(.I+1);
	OUTC(%C':'); OUTC(%C' ');
	PRDISP(.B[.I]);
	IF .I LSS .T-1
	THEN
	    IF .I
	    THEN
		(OUTCRLF(); OUTS('		') )	! Two tabs
	    ELSE
		OUTS('		')		! spc-spc-tab
	END;
ROUTINE PRCOUNTEDVECTOR(V: REF VECTOR): NOVALUE=
    BEGIN
    OUTS(' =[');
    OUTDEFAULT(.V[0]);
    OUTS(']: ');
	
    INCR I FROM 1 TO .V[0] DO
	BEGIN
	PRDISP(.V[.I]);
	OUTC(%C' ');
	IF .I MOD 6 EQL 0 THEN OUTCRLF();
	END;
    OUTCRLF()
    END;
ROUTINE PRHPARMS(F: $FRAME) : NOVALUE=
!+
! FUNCTION
!	Print argument-lists passed to a condition-handler.
! INPUT
!	F	- Pointer to a FRAME
! OUTPUTS
!	None
!-
    BEGIN
    LOCAL
	SIGNL,
	MECH,
	ENBL;

    OUTCRLF();
    SIGNL = GETARGADR(1,.F);
    MECH  = GETARGADR(2,.F);
    ENBL  = GETARGADR(3,.F);

    OUTS('Signalv at ');		! Condition signalled
    PRDISP(..SIGNL);
    PRCOUNTEDVECTOR(..SIGNL);		!  and the whole SIGNAL arg-list

    OUTS('Mechanismv at ');		! Mechanism information
    PRDISP(..MECH);
    PRCOUNTEDVECTOR(..MECH);

    OUTS('Enablev at ');		! ENABLE stuff
    PRDISP(..ENBL);
    PRCOUNTEDVECTOR(..ENBL);
    END;
ROUTINE PRCALL(F: $FRAME,CALLED: REF $INSTRUCTION)=
!+
! FUNCTION
!	Print a single Routine call with its parameters.
! INPUTS
!	F	- Pointer to FRAME
!	CALLED	- Pointer to instruction which did the call
! OUTPUTS
!	Returns address of instruction which called the routine whose
!	frame we are examining.
! NOTES
!	The condition-handling routines are treated special.  There are several
!	"internal" routines which interact to produce a SIGNAL.  Only the
!	last routine in the OTS (which calls the handler) will end up with
!	a mention in the routine-call display.
!
!	A side-effect of the above is that when a "CALL n" command is given,
!	that fewer than "n" frames will be displayed.
!-
    BEGIN
    LOCAL
	NP,			! NUMBER of PARAMETERS
	CALLFROM;		! Who called this routine..
    LABEL
	L;

    IF (CALLFROM = GETCALLFROM(.F)) LEQ 0 THEN RETURN 0;
    NP = GETARGCNT(.F);

    IF WithinSignalHandler(.CALLED<RH>) AND
	NOT WithinSignalHandler(.CALLFROM<RH>)
    THEN
	RETURN .CALLFROM<RH>;

    IF WITHINSIGNALHANDLER(.CALLFROM<RH>)
    THEN
	! Within SIGNAL Handler.  There are several possible cases.  If
	! the called routine is ALSO inside the OTS, then suppress it.
	!
	BEGIN
	IF NOT WITHINSIGNALHANDLER(.CALLED<RH>)
	THEN
	    BEGIN				%(print signal)%
	    ! Here we would like to print out
	    !   SIGNAL(nn)
	    !   SIGNAL_STOP(nn)
	    !   Doing UNWIND
	    !
	    BIND
		SIGVAL = .(F[LOCALS_BASE])+1;	! Signalled condition value



	    IF .UNWINDVALUE NEQ 0 AND .SIGVAL EQL .UNWINDVALUE
	    THEN
		OUTS('*** Doing UNWIND ***')
	    ELSE
		BEGIN
		IF .SIGVAL<0,3> EQL 4 
		THEN
		    OUTS('*** SIGNAL_STOP(')
		ELSE
		    OUTS('*** SIGNAL(');
		OUTDEFAULT(.SIGVAL);
		OUTS(') ***')
		END
	    END;
	RETURN(.CALLFROM<RH>)
	END %(in signal handler)%;


    PRXDISP(.CALLED);
    OUTS(%CHAR(9),'from',%CHAR(9));
    IF WITHINSIX12(.CALLFROM<RH>)
    THEN
	 OUTS('"within SIX12"')
    ELSE
	PRDISP(.CALLFROM);

L:  BEGIN
    IF .NP EQL 0
    THEN
	OUTS('  ( )')
    ELSE
	BEGIN
	IF .F[NEXT_FRAME] NEQ 0
	THEN
	    BEGIN
	    IF .NP EQL 3 AND WITHINSIGNALHANDLER(GETCALLFROM(.F[NEXT_FRAME]))
	    THEN
		BEGIN
		PRHPARMS(.F);
		LEAVE L
		END
	    END;

	OUTCRLF();
	IF .SIXHDR NEQ 0
	THEN
	    BEGIN %(user handler)%
	    LOCAL
		OLDRNAME,
		ABASE,
		ROUT	: SYMBOL;

	    ABASE = GETARGBASE(.F,.NP);
	    OLDRNAME = .RNAME;
	    INSIXHDR = 1;
	    ROUT = SDDTFS(.CALLED<RH>);
	    IF NOT (.SIXHDR)(.ROUT[VALUEWRD],F50TO6(.ROUT[NAMEWRD]),.ABASE,.NP,1)
	    THEN
		BEGIN %(user punted)%
		OUTS('	Actuals	');
		PRG( .ABASE, .NP);
		END;
	    INSIXHDR = 0;
	    RNAME = .OLDRNAME;
	    END %(user handler)%
	ELSE
	    BEGIN %(standard handler)%
	    OUTS('	Actuals	');
	    PRG( GETARGBASE(.F,.NP), .NP);
	    END %(standard handler)%;
	END;
    END;


    .CALLFROM<RH>
    END;
MACRO
    $ENABLE	= HBLOCK FIELD(ENABLE_FIELDS) %;

FIELD
    ENABLE_FIELDS=
	SET
	HANDLER_PTR=	[ 0, 0, 36, 0],		! Addr of HANDLER routine
	EXIT_PTR=	[ 1, 0, 36, 0]		! Addr of exit code to clean
						!  stack for unwinds, etc.
	TES;


!
!
!	efpnt.:
!	+------------+
!	|	    |----------+
!	+------------+		|		|		|
!				|		+---------------+
!				|		| rtn addr      |
!				|		+---------------+
!				|		| parms	 |
!				|		/		/
!				|		/		/
!				|		|		|
!				|		+---------------+
!				|		|   locals      |\
!				|		/		/ |
!				|		/		/ |
!				|		+---------------+ |
!				|		| rtn addr      | |
!				|		+---------------+ |
!				|		| parms	 | |
!				|		/		/ |
!				|		/		/ |
!				|		|	       |/
!				|		+---------------+
!				|		|   locals      |\
!				|		/		/ |
!				|		/		/ |
!				|		|		| |
!				|		+---------------+ |
!				|      ...<-----| enable ptr    | |
!				|	  	+---------------+ |
!				+------->+------| efpnt chain	| |
!					 |	+---------------+ |
!					 |	| rtn addr      | |
!					 |	+---------------+ |
!					 |	| parms		| |
!					 |	/		/ |
!					 |	/		/ |
!					 |	|		|/
!					 |	+---------------+
!					 |	|		|\
!					 |	   ...		  .
!					 |	| rtn addr      | |
!					 |	+---------------+ |
!					 |	| parms	 | |
!					 |		...	. .
!					 |	|		| |
!					 |      +---------------+ |
!					 |      | enable ptr    |-+--+
!					 |	+---------------+ |  |
!					 +----->| efpnt chain   | |  |
!						+---------------+ |  |
!							...	  .  |
!		+-------------+					     |
!		| handler  ptr|<-------------------------------------+
!		+-------------+
!		| exit ptr    |
!		+-------------+
ROUTINE PRHANDLER (F: $FRAME, EFP) =
!+
! FUNCTION
!	returns an updated EFP if in fact a handler is printed
!-
    BEGIN
    IF .F[NEXT_FRAME] NEQ 0 AND
	.F[NEXT_FRAME] LSS .F<RH>
    THEN
	BEGIN
	IF .EFP GTR .F[NEXT_FRAME] AND .EFP LSS .F<RH>
	THEN
	    BEGIN %( have active handler )%
	    LOCAL
		ECODE	: REF $INSTRUCTION;	! pointer to exit code

	    ECODE = ..(.EFP+1);
	    EFP = ..EFP;
	    WHILE .ECODE[M_OPCODE] NEQ DEBUGUUO DO
		BEGIN %( scan for call )%
		IF .ECODE[M_OPCODE] EQL PUSHJOP 
		THEN
		    SELECTONE .ECODE[M_OFFSET] OF
		    SET
		    [ SIGNA$, SIGST$ ]:
			EXITLOOP;	! SIGNAL or SIGNAL_STOP

		    [OTHERWISE]:
			BEGIN
			OUTCRLF();
			OUTS('	Handler: ');
			PRXDISP(.ECODE[M_OFFSET]);
			EXITLOOP
			END
		    TES
		ELSE
		    ECODE = .ECODE + 1;
		END %( scan for call )%;
	    END %(have active handler )%;
	END;
    RETURN .EFP;
    END;
ROUTINE PSTK(FBACK: $FRAME, SHOWLOCALS, LEVEL):NOVALUE=
!+
! FUNCTION
!	Display call stack to level "Level", "ShowLocals" controls
!	locals display.
!-
    BEGIN
    LOCAL
	F	: $FRAME,
	NAME,
	NL,
	EFP	: $ENABLE;

    EFP = .EFPNT$;

    ! now go down the chain (skipping the implicit SIX12 handler)
    ! until we get to the first handler below the SIX12 entry

    WHILE .EFP<RH> GTR .ENTERPNT<RH> DO EFP = ..EFP;

    IF .RTNLVL GEQ 0
    THEN
	NAME = .RNAME
    ELSE
	BEGIN
	IF (NAME = GETCALLFROM(.FBACK)) LSS 0 THEN RETURN;
	NAME = .(.NAME)<RH>;
	END;

    F = .FBACK<RH>;

    DO
	BEGIN
	LOCAL
	    NEWEFP;

	IF (NAME = PRCALL(.F,.NAME)) EQL 0 THEN RETURN;
	NEWEFP = PRHANDLER(.FBACK<RH>,.EFP);
	IF .SHOWLOCALS
	THEN 
	    BEGIN
	    NL = GETLCLCNT(.FBACK);
	    IF .NL GTR 0		! PRINT LOCALS
	    THEN
		BEGIN
		OUTCRLF();
		OUTS('	Locals	');
		IF .NEWEFP NEQ .EFP	! We found an ENABLE in this frame
		THEN
		    PRG( F[LOCALS_BASE]+2, .NL )	! Ignore ENABLE-list
		ELSE
		    PRG( F[LOCALS_BASE], .NL)		! Ignore saved FP
		END
	    END;
	EFP = .NEWEFP;
	CRLF;
	IF (.F[NEXT_FRAME] NEQ 0) AND (.F[NEXT_FRAME] LSS .F<RH>) AND NOT WITHINSIX12(.NAME<RH>)
	THEN
	    BEGIN
	    FBACK = .F;
	    F = .F[NEXT_FRAME]
	    END
	ELSE
	    RETURN
	END
    UNTIL (LEVEL = .LEVEL-1) LEQ 0;

    END;
%SBTTL	'Debug Interest Routines'
!		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 ! 0
!		!------------------+------------------!
!		! POINTERS to      ! CONDITIONAL      ! 1
!		!  bit 19 action   !  bit 18 action   !
!		!------------------+------------------!
!		! Macro		   ! TEXTS	      ! 2
!		!  bit 21 action   !  bit 20 action   !
!		!------------------+------------------!
!		!		   !		      ! 3
!		!  bit 23 action   !  bit 22 action   !
!		!------------------+------------------!
!		!		   !		      ! 4
!		!  bit 25 action   !  bit 24 action   !
!		!------------------+------------------!
!
!	(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.
!
FIELD
    ROUT_FIELDS=
	SET
	ROUT_INFO=	[0, 0, 36, 0],	! ADDR+INFO bits
	ROUT_ADDR=	[0, 0, 18, 0],	! Routine Address
	INTEREST_BITS=	[0, 18,18, 0],	! All interest bits, lumped together
	    BREAKF=	[0, 18, 1, 0],	! Routine BREAK set
	    ABREAKF=	[0, 19, 1, 0],	! Routine ABREAK set
	    OPQATF=	[0, 20, 1, 0],	! OPAQUE
	    OPQAFTF=	[0, 21, 1, 0],	! OPAQUE After
	    TRCATF=	[0, 22, 1, 0],	! TRACE
	    TRCAFTF=	[0, 23, 1, 0],	! ATRACE
	    TABREAKF=	[0, 24, 1, 0],	! ??
	    PREVSTEPF=	[0, 32, 1, 0],
	    PREVOFFF=	[0, 33, 1, 0],
	    IDIDONF=	[0, 34, 1, 0],
	    IDIDOFFF=	[0, 35, 1, 0],
	COND_18_ACT=	[1, 0, 18, 0],	! Conditional action on break
	COND_19_ACT=	[1, 18,18, 0],	! Conditional action on ABREAK
	COND_20_ACT=	[2, 0, 18, 0],
	COND_21_ACT=	[2, 18,18, 0],
	COND_22_ACT=	[3, 0, 18, 0],
	COND_23_ACT=	[3, 18,18, 0],
	COND_24_ACT=	[4, 0, 18, 0],
	COND_25_ACT=	[4, 18,18, 0]
	TES;

MACRO
    INTEREST(J) = 0,J,1,0 %,				! The j-th interest bit
    CNDACTION(J)= 1+((J-18)/2), (J AND 1)*18,18,0 %;	! Conditional text ptr
							!  for j-th action.

OWN
	ROUTS	: BLOCKVECTOR[ROUTSCNT,ROUTSIZE] FIELD(ROUT_FIELDS);
    
LITERAL
	BREAKV=BITVAL(18),		ABREAKV=BITVAL(19),
	OPQATV=BITVAL(20),		OPQAFTV=BITVAL(21),
	TRCATV=BITVAL(22),		TRCAFTV=BITVAL(23),
	TABREAKV=BITVAL(24),

	MAXACTRTN=24,

	PREVSTEPV=BITVAL(32),
	PREVOFFV=BITVAL(33),		IDIDONV=BITVAL(34),
	IDIDOFFV=BITVAL(35);
ROUTINE CFINDR(R)=
!+
! FUNCTION
!	CONDITIONAL FIND - locate the index of Routine R IN ROUTS.
! INPUTS
!	R	- ROUTINE Address
! OUTPUT
!	Index in ROUTS of the entry
!	-1 If not found
!-
    DECR I FROM .NROUTS TO 0 DO
	IF .ROUTS[.I,ROUT_ADDR] EQL .R<RH> THEN RETURN .I;
ROUTINE CINSERT(R)=
!+
! FUNCTION
!	Conditionally insert a routine into ROUTS, if it isn't there already.
! INPUTS
!	R	- Routine address
! OUTPUT
!	Return THE INDEX of R IN ROUTS. INSERT If NECESSARY
!-
    BEGIN
    LOCAL
	L;
    IF (L = CFINDR(.R)) GEQ 0 THEN RETURN .L;

    NROUTS = .NROUTS + 1;			! Not present, add it
    ROUTS[.NROUTS,ROUT_INFO] = .R<RH>;

    .NROUTS
    END;
ROUTINE CREMOVE(R,VAL): NOVALUE=
!+
! FUNCTION
!	Conditional remove. Turn off bits specified by VAL in
!	the entry for R. Delete R if no other interest bits are set.
! INPUTS
!	R	- A routine address
!	VAL	- Mask of un-interesting bits
!-
    BEGIN
    LOCAL
	L;

    IF (L = CFINDR(.R)) LSS 0 THEN RETURN;	! No EVENTs established

    IF (VAL = .ROUTS[.L,ROUT_INFO] AND .VAL) EQL 0
    THEN				! The EVENTs we are looking at aren't
	RETURN;				!  interesting for this routine.

    IF (.VAL AND OPQAFTV) NEQ 0 AND .ROUTS[.L,IDIDOFFF]
    THEN
	BEGIN
	OPQCNT = 0;
	TRACEFLAG = -.ROUTS[.L,PREVOFFF];
	STEPFLAG = -.ROUTS[.L,PREVSTEPF];
	ROUTS[.L,ROUT_INFO] = .ROUTS[.L,ROUT_INFO] AND NOT (IDIDOFFV+PREVOFFV+PREVSTEPV)
	END;

    IF (.VAL AND TRCAFTV) NEQ 0 AND .ROUTS[.L,IDIDONF]
    THEN
	TRCCNT = TRACEFLAG = ROUTS[.L,IDIDONF] = 0;

    ROUTS[.L,ROUT_INFO] = .ROUTS[.L,ROUT_INFO] AND NOT .VAL;

    DECR IDX FROM MAXACTRTN TO 18 DO
	BEGIN
	MAP
	    VAL	: BITVECTOR;			! Count number of conditions
	IF .VAL[.IDX] THEN INCRTOG;		!  which are active?
	END;

    IF .ROUTS[.L,INTEREST_BITS] NEQ 0 THEN RETURN;	! Still some EVENTs
							!  of interest

    ! Nothing interesting remains for this routine.  Remove it from the
    ! table, by copying up the last routine in the table into the deletion
    ! slot
    !
    IF .L LSS .NROUTS
    THEN						! Fill in empty holes
	DECR J FROM ROUTSIZE-1 TO 0 DO			!  by copying down
	    ROUTS[.L,.J,FW] = .ROUTS[.NROUTS,.J,FW];

    NROUTS = .NROUTS -1
    END;
ROUTINE SETTBLBIT(ROUTN,ISITEXIT):NOVALUE=
!+
! FUNCTION
!	This routine sets a bit in the DEBUG UUO instruction itself,
!	indicating that this routine is "interesting"
! INPUT
!	ROUTN	- Routine address
!	ISITEXIT- Flag indicating if we are setting action on routine-entry
!		  or routine exit.
!-
    BEGIN
    LOCAL
	PNTR	: REF $INSTRUCTION;

    PNTR = FNDDBGUUO(.ROUTN,.ISITEXIT);

    IF .PNTR LSS 0
    THEN
	(PRDISP(.ROUTN);  ERROR(6))
    ELSE
	CHKUWP( PNTR[0,TBLBIT] = 1 , .PNTR);

    ! This may be the DEBUG UUO for the unwind exit, try again
    !
    IF .PNTR[0,UNWINDBIT]
    THEN
	BEGIN
	PNTR = FNDDBGUUO(.PNTR+1,.ISITEXIT);
	IF .PNTR LSS 0 
	THEN
	    (PRDISP(.ROUTN); ERROR(6))
	ELSE
	    CHKUWP( PNTR[0,TBLBIT] = 1, .PNTR)
	END
    END;
ROUTINE SETBIT(VAL:BITVECTOR, FBEGIN, FEND):NOVALUE=
!+
! FUNCTION
!	Set interest bits and action-pointers into the ROUTS table
! INPUTS
!	VAL	- mask of interesting bits
!	FBEGIN	- Flag indicating interest at routine entry
!	FEND	- Flag indicating interest at routine exit
!
! IMPLICIT INPUTS
!	SIXLP[0]	- CH$PTR to conditional action text
!	SIXRP[0..N]	- ROUTINE addresses
! OUTPUT
!	None
!-
    BEGIN
    LOCAL
	L;

    IF .SIXLC EQL 0 THEN SIXLP = UPLIT(0);	! Unconditional Actions

    INCR IDX FROM 18 TO MAXACTRTN DO
	IF .VAL[.IDX]				! Interesting "event"
	THEN
	    DECR I FROM .SIXRC-1 TO 0 DO
		BEGIN
		L = CINSERT(.SIXRP[.I]);
		IF NOT .ROUTS[.L, INTEREST(.IDX)] THEN DECRTOG;	! New interest
		ROUTS[.L, INTEREST(.IDX)] = 1;			!  added
		ROUTS[.L, CNDACTION(.IDX)] = .SIXLP[0];

		! Mark routine entry and exit as necessary
		!
		IF .FBEGIN NEQ 0 THEN SETTBLBIT(.(SIXRP[.I])<RH>,0);
		IF .FEND NEQ 0 THEN SETTBLBIT(.(SIXRP[.I])<RH>,1)
		END;
    END;
ROUTINE UNSETBIT(VAL)=
    DECR I FROM .SIXRC-1 TO 0 DO CREMOVE(.SIXRP[.I],.VAL);
ROUTINE XBREAK:NOVALUE=
    BEGIN
    SETBIT(BREAKV,1,0);
    BUGCHECK(-34,RETURN)
    END;

ROUTINE DBREAK : NOVALUE=UNSETBIT(BREAKV);

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

ROUTINE DABREAK : NOVALUE =UNSETBIT(ABREAKV);

ROUTINE OPAQUE:NOVALUE=
	SETBIT(OPQAFTV+(IF .MODEFLAG NEQ 1 THEN OPQATV ELSE 0),1,1);

ROUTINE DOPAQUE : NOVALUE=
	UNSETBIT(OPQAFTV+(IF .MODEFLAG NEQ 1 THEN OPQATV ELSE 0));
ROUTINE XTRACE:NOVALUE=
    BEGIN
    SETBIT((CASE .MODEFLAG FROM 0 TO 2 OF
		SET
		[0]:	TRCATV;
		[1]:	TRCAFTV;
		[2]:	TRCAFTV+TRCATV
		TES
	    ),1,1);

    BUGCHECK(-34,0)
    END;
ROUTINE DTRACE=
	UNSETBIT(CASE .MODEFLAG FROM 0 TO 2 OF
		SET
		[0]:	TRCATV;
		[1]:	TRCAFTV;
		[2]:	TRCAFTV+TRCATV
		TES
		);
ROUTINE STABREAK(RTN): NOVALUE=
!+
! FUNCTION
!	Set a Temporary ABREAK on a routine.
! INPUT
!	RTN	- routine address
!-
    BEGIN
    STACKLOCAL
	L;			! Dummy for SIXRP target

    SIXLC=0;			! fake unconditional break
    SIXRC=1;
    SIXRP=L;			! pointer to name of routine
    L=(.RTN);			! name of routine

    SETBIT(TABREAKV,0,1)	! go set bit
    END;

ROUTINE DSTABREAK(RTN): NOVALUE=
!+
! FUNCTION
!	???
! INPUTS
!	RTN	- Routine address with a possible TRACE after
!-
    BEGIN
    LOCAL
	L;

    SIXRC=1;
    SIXRP=L;
    L=(.RTN);
    UNSETBIT(TABREAKV)
    END;
%SBTTL	'Monitor|Watch Variables'
!		MONITORING of VARIABLES
!		-----------------------

! The monitoring routines use another table with two-word entries,
! formatted
!
!	!---------------!---------------!
!	!	WATCHED_LOCATION	!
!	!---------------!---------------!
!	!	WATCHED_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.

FIELD
    WATCH_FIELDS=
	SET
	WATCHED_LOCATION=	[0, FW],	! Address
	WATCHED_VALUE=		[1, FW]		! Old value
	TES;

OWN
    MONVALS:	BLOCKVECTOR[MONITCNT,2] FIELD(WATCH_FIELDS);

MACRO
	WATCHTAG=0, WATCHFLAG %;
ROUTINE PRBPTR(ENTRY:$BYTE_POINTER):NOVALUE=
!+
! FUNCTION
!	Print out a PDP-10 byte-pointer being used for WATCH or MONITOR
!	points.
! INPUT
!	ENTRY	- Hardware byte pointer
!-
    BEGIN

    PRDISP(.ENTRY[P_OFFSET]);				! PRINT NAME

    IF .ENTRY[P_POS_SIZE] NEQ 36	! Non-fullwords get qualified <p,s>
    THEN
	BEGIN			! PRINT <P,S>
	OUTC(%C'<');
	OUTFD(.ENTRY[P_POS],0);
	OUTC(%C',');
	OUTFD(.ENTRY[P_SIZE],0);
	IF .ENTRY[P_INDEX] NEQ 0
	THEN
	    BEGIN
	    OUTC(%C',');  OUTD(.ENTRY[P_INDEX]);
	    OUTC(%C',');  OUTD(.ENTRY[P_INDIRECT]);
	    END;
	OUTC(%C'>')
	END
    END;
ROUTINE PRMVALSNAM(ENTRY: $BYTE_POINTER):NOVALUE=
!+
! FUNCTION
!	Print byte pointer with W(atch) or M(onitor) indicator
! INPUT
!	ENTRY	- Hardware byte pointer
!-
    BEGIN
    IF .ENTRY<WATCHFLAG> THEN OUTC(%C'W') ELSE OUTC(%C'M');
    OUTC(%C'-'); OUTC(%C' ');
    PRBPTR(.ENTRY)
    END;
ROUTINE CKVALS(RTN,TOG):NOVALUE=
!+
! FUNCTION
!	CHECK FOR CHANGED VALUES IN THE MONITOR TABLE
! INPUTS
!	RTN	- Address
!	TOG	- Controls printout as follows
!			TOG < 0		Internal call, not from a user
!					routine. [Probably XASSIGN]
!			TOG >= 0	Called during DEBUG UUO processing
!
!			TOG<0,1>	1 = Break AFTER
!					0 = Break BEFORE
!
!-
    BEGIN
    DECR I FROM .NVALS TO 0 DO
	BEGIN
	LOCAL
	    X;

	X = SCANN(MONVALS[.I,WATCHED_LOCATION]);
	IF .X NEQ .MONVALS[.I,WATCHED_VALUE]
	THEN
	    BEGIN
	    IF .TOG GEQ 0
	    THEN
		BEGIN
		OUTS('*** ');
		IF .TOG
		THEN
		    OUTS('During ')
		ELSE
		    OUTS('Before ');

		IF NOT .MONVALS[.I,WATCHTAG] THEN TOG = -1;
		PRXDISP(.RTN);
		IF .TOG THEN 0 ELSE
		    BEGIN
		    OUTS(' from ');
		    PRDISP(GETCALLFROM(.ENTERPNT))
		    END;
		CRLF
		END;

	    PRMVALSNAM(.MONVALS[.I,0,FW]);
	    PUTTAB;
	    OUTS('Old: ');
	    OUTDEFAULT(.MONVALS[.I,WATCHED_VALUE]);
	    PUTTAB;
	    OUTS('New: ');
	    OUTDEFAULT(.X);
	    CRLF;
	    MONVALS[.I,WATCHED_VALUE] = .X
	    END
	END;

    IF .TOG EQL -1  THEN STOPIT()
    END;
ROUTINE XPRINTMON:NOVALUE=
!+
! FUNCTION
!	COMMAND: PRINT MONITOR
!-
    BEGIN
    IF .NVALS LSS 0 THEN RETURN OUTS('No monitored locations',%CHAR(13,10));

    DECR I FROM .NVALS TO 0 DO
	BEGIN
	PRMVALSNAM(.MONVALS[.I,0,FW]);
	OUTS(%STRING(%CHAR(9),'= '));
	OUTDEFAULT(.MONVALS[.I,WATCHED_VALUE]);
	DBLEQL();
	PRDISP(.MONVALS[.I,WATCHED_VALUE]);
	CRLF
	END
    END;
ROUTINE DOMON(WATCHBIT):NOVALUE=
!+
! FUNCTION
!       Implements MONITOR and WATCH commands
! INPUTS
!       WATCHBIT	- 0=> MONITOR command
!			 1=> WATCH command
!-
    BEGIN
    LABEL
	L;
    LOCAL
	X;
    MAP
	SIXRP	: REF BLOCKVECTOR[, 1] FIELD(BYTEPOINTER_FIELDS);

    IF .SIXRC EQL 0
    THEN
	! Report current entries
	!
	BEGIN
	MODEFLAG = 4;		! SO XPRINTMON WILL BE CALLED
	RETURN
	END;

    ! MAKE A NEW ENTRY
    !
    DECR I FROM .SIXRC-1 TO 0  DO
L:	BEGIN
	IF .SIXRP[.I,P_LHALF] EQL 0	! Change address to a valid byte-ptr
	THEN				!  with <0,36>
	    SIXRP[.I,P_LHALF] = %O'004400';

	IF .SIXRP[.I,P_INDEX] NEQ 0 OR
	    .SIXRP[.I,P_INDIRECT]	! Having index-reg or indirect is
	THEN				!  frowned upon
	    (PRMVALSNAM(.SIXRP[.I,P_FWORD]);  RETURN ERROR(18));

	IF NOT ISREADABLE(.SIXRP[.I,P_FWORD] AND AddrMask)
	THEN
	    BEGIN
	    ILLMEM = .SIXRP[.I,P_FWORD] AND AddrMask;
	    ERROR(IF NOT ISADDRESS(.ILLMEM) THEN 28 ELSE 33);
	    RETURN
	    END;

	DECR J FROM .NVALS TO 0 DO
	    IF (.MONVALS[.J,WATCHED_LOCATION] AND %O'777737777777')  EQL .SIXRP[.I,P_FWORD]
!					   ^^ mask out watch bit
	    THEN 
		BEGIN
		! same location, we may be changing watch flag
		MONVALS[.J,WATCHTAG] = .WATCHBIT;
		LEAVE L;
		END;
	DECRTOG;
	NVALS = .NVALS+1;
	MONVALS[.NVALS,WATCHED_LOCATION] = .SIXRP[.I,P_FWORD];
	MONVALS[.NVALS,WATCHTAG] = .WATCHBIT;
	MONVALS[.NVALS,WATCHED_VALUE] = SCANN(SIXRP[.I,P_FWORD])
	END;

    BUGCHECK(-34,0)
    END;
ROUTINE XMONITOR : NOVALUE= DOMON(0);

ROUTINE XWATCH: NOVALUE = DOMON(1);
ROUTINE XDMONITOR:NOVALUE=
!
! DELETE ENTRY from MONITOR VALUES TABLE
!
    BEGIN
	LABEL LB;
    LOCAL
	L;
    MAP
	SIXRP	: REF BLOCK;

    DECR I FROM .SIXRC-1 TO 0 DO
LB:	BEGIN
	IF .SIXRP[.I,LH,0] EQL 0
	THEN
	    SIXRP[.I,LH,0] = %O'004400';	! INSERT <FW>
	L = (
	    DECR J FROM .NVALS TO 0 DO
		IF (.MONVALS[.J,WATCHED_LOCATION] AND %O'777737777777')  EQL .SIXRP[.I,FW]
		THEN
		    EXITLOOP .J
	    );

	IF .L LSS 0
	THEN
	    BEGIN
	    OUTS('No entry for ');
	    PRMVALSNAM( .SIXRP[.I,FW] );
	    CRLF;
	    LEAVE LB;
	    END;
	INCRTOG;
	IF .L LSS .NVALS
	THEN
	    BEGIN
	    MONVALS[.L,WATCHED_LOCATION] = .MONVALS[.NVALS,WATCHED_LOCATION];
	    MONVALS[.L,WATCHED_VALUE] = .MONVALS[.NVALS,WATCHED_VALUE];
	    END;
	NVALS = .NVALS-1;
	END;
    END;
%SBTTL	'Miscellaneous Command Action Routines'

!		THE DEBUG PROCESSING ROUTINES
!		-----------------------------

ROUTINE DOTVREG =
!+
! FUNCTION
!	"No-op" routine which is used frequently in tables to provide a
!	default action routine with no nasty side-effects.
!-
    BEGIN
    REGISTER
	R = VREG;

    .R
    END;
ROUTINE RET612:NOVALUE=
!+
! FUNCTION
!	This routine restores the SIX12 registers saved by XDDT before
!	entering DDT.  Doing a POPJ SP, then returns us to where we were
!	relative to XDDT.
!
! NOTES
!	This routine is never called directly.
!-
    BEGIN
    REGISTER
	R;
    R = SIXACS^18;		! This is JRST-ed to to restore SIX12
    BLT(R,%O'17')		!  after a visit into DDT
    END;
ROUTINE XDDT:NOVALUE=
!+
! FUNCTION
!	This routine locates DDT, saves the registers and SP, and
!	jumps to the DDT entry-point.  ?.JBOPC is pre-loaded with
!	where to return to.  This is accessed by the DDT command
!			SIXRET$X
!	which results in a JRST @.JBOPC instruction.  RET612 is a
!	critical routine.
!
!	BEWARE:	There should be NO "STACKLOCAL" storage in this routine
!		either!
!-
    BEGIN
    REGISTER
	R;

    R = SIXACS;
    BLT(R,SIXACS[15]);		! Preserve the AC's when we enter DDT.

%IF EXTENDED
%THEN
    $JBOPC = 1^18+RET612;
%ELSE
    $JBOPC = (RET612);		! N.B. that this implies that you cannot
				!  actually modify a register from DDT, unless
				!  you modify SIXACS..SIXACS+15
%FI
%IF TOPS10
%THEN
    IF .$JBDDT<RH> EQL 0 THEN RETURN ERROR(21);
    JRST(0,.$JBDDT);
%ELSE
    BEGIN
    OWN
	SAVENTVEC;
    REGISTER
	PROTECTION;

    RPACS( $FHSLF^18 + %O'770'; PROTECTION );	! Check page 770 for ddt

    IF (.PROTECTION AND PA_PEX) EQL 0	! Non-existant page...
    THEN
	BEGIN
	LOCAL
	    JFN;

	GEVEC( $FHSLF ; SAVENTVEC );	! Save entry vector, GET will smash

	IF GTJFN( GJ_OLD+GJ_PHY+GJ_SHT,	! Old file, use system logicals
		MSG( 'SYS:UDDT.EXE');
		JFN)
	THEN
	    IF GET( $FHSLF^18 + GT_NOV + .JFN )
	    THEN
		SEVEC( $FHSLF, .SAVENTVEC )
	    ELSE
		RETURN ERROR(21)
	ELSE					! Can't find file, so quit with
	    RETURN ERROR(10);			!  appropriate message

	IF .$JBSYM NEQ 0		! Ensure symbols loaded
	THEN
	    .%O'770001' = .$JBSYM;	! Copy pointer into DDT

	.%O'770002' = .$JBUSY		! and undefined symbol pointer
	END;

    JRST(0,%O'770000')			! Always loads at this address
    END
%FI
    END;
ROUTINE SLASH(PARSE):NOVALUE=
!+
! FUNCTION
!       Print range of memory locations according to either the "!" infix
!       operator or the "/" postfix operator.
! INPUTS
!       PARSE   - indicates which parse was detected.
!-
    BEGIN
    LOCAL
	N;		      ! Number of locations to display
    MAP
	SIXLP   : HBLOCK;

    N = (IF .PARSE EQL 3 THEN .SIXRP[0] - 1 ELSE 0);

    INCRA A FROM .SIXLP[0,RH,0] TO .SIXLP[0,RH,0]+.N DO
	BEGIN
	PRDISP(.A);
	OUTC(%C'/');
	PUTTAB;
	IF NOT ISREADABLE(.A)
	THEN
	    BEGIN
	    OUTS('?');
	    CRLF;
	    EXITLOOP
	    END;
	OUTRDEF(..A,14);
	DBLEQL();
	PRDISP(..A);
	CRLF;

	IF ISON(ENABFLAG) AND ISOFF(NOPOLLFLAG) AND (.A MOD 4) EQL 0
	THEN
	    BEGIN		! During long type-outs, give user
%IF TOPS10			!  an opportunity to escape from
%THEN				!  "core-dump".....
	    IF SKPINL() THEN EXITLOOP;
%ELSE
	    IF NOT SIBE($PRIIN) THEN EXITLOOP;		! Input buffer empty
%FI
	    END
	END
    END;
ROUTINE GOER:NOVALUE=
    BEGIN
    IF ISON(TRACEFLAG) THEN DECRTOG;
    GOFLAG = 1;
    END;

ROUTINE CLRSTEP:NOVALUE=(SETOFF(STEPFLAG));

ROUTINE XGO:NOVALUE=(CLRSTEP(); GOER());

ROUTINE XNOPOLLON:NOVALUE=(SETON(NOPOLLFLAG));

ROUTINE XNOPOLLOFF:NOVALUE=(SETOFF(NOPOLLFLAG));

ROUTINE XCOPAQUE:NOVALUE=(SETON(COPQFLAG));

ROUTINE XNOCOPAQUE:NOVALUE=SETOFF(COPQFLAG);
ROUTINE DISAB:NOVALUE=(SETOFF(ENABFLAG));

ROUTINE XSTEP:NOVALUE=
    BEGIN
    BUGCHECK(35,RETURN);
    SETON(STEPFLAG);
    GOER()
    END;
ROUTINE XOK:NOVALUE=
! XOK performs the following actions
!	(1) set a temporary ABREAK at the current routine
!	(2) do a GO (XGO)
!
!	The temporary ABREAK is removed when encountered
!
	BEGIN

	BUGCHECK(35,RETURN );

	IF .RTNLVL EQL 0
	THEN			    ! OK works only at routine entry
	    BEGIN
	    STABREAK(.RNAME);
	    XGO()
	    END
	ELSE
	    ERROR(24)
	END;
ROUTINE XSTRACE:NOVALUE=
    BEGIN
    IF .OPQCNT GTR 0
    THEN
	BEGIN
	OPQCNT = 0;
	DECR J FROM .NROUTS TO 0 DO
	     ROUTS[.J,0,FW] = .ROUTS[.J,0,FW] AND NOT (IDIDOFFV+PREVOFFV+PREVSTEPV)
	END;
    SETON(TRACEFLAG);
    END;
ROUTINE XCLRTRACE:NOVALUE=(SETOFF(TRACEFLAG));
ROUTINE XGOTRACE:NOVALUE=(XSTRACE(); CLRSTEP();  GOER());
ROUTINE XGOCLR:NOVALUE=(SETOFF(TRACEFLAG); CLRSTEP(); GOER());
ROUTINE NOSIX12:NOVALUE=
!+
! FUNCTION
!       Disable SIX12's UUO handler by placing a JFCL 0 into location
!       41(8).
!-
    IF ISOFF(ERRORFLAG) THEN ($JB41 = DBG_OFF_INST;  GOER());
ROUTINE XDEBUG: NOVALUE=
!+
! FUNCTION
!	Set up debugging environment by making LUUO trap location be
!	a call of the SIX12 UUO handler.
!-
    IF ISOFF(ERRORFLAG)
    THEN
	$JB41 = DBG_ON_INST;		! Transfer to UUOH
ROUTINE XBASE(K):NOVALUE=
!+
! FUNCTION
!	Set default radix for type-in and type-out.
! INPUTS
!	K	- distinguishes between NILADIC and PREFIX command form
! NOTES
!	SIXRP[0] contains new radix.
!-
    BEGIN		! set IOBase
    IF .K
    THEN
	BEGIN
	IF .SIXRP[0] EQL 0 THEN (.SIXRP) = 8;
	IF ((.SIXRP[0] LSS 2) OR (.SIXRP[0] GTR 10))
	THEN
	     RETURN ERROR(5)
	ELSE
	     (IOBASE = .SIXRP[0])
	END;

    OUTD(.IOBASE);
    OUTS(' decimal');
    OUTCRLF()
    END;
ROUTINE XWBASE(K):NOVALUE=
    BEGIN		! set WDBase
    IF .K THEN WDBASE = ..SIXRP;
    OUTDEFAULT(.WDBASE);
    CRLF;
    END;
ROUTINE XBACKTO:NOVALUE=
    BEGIN
    IF .DEPTH LEQ 1
    THEN
	RETURN ERROR(29);		! no place to go back to
    IF .SIXRP[0] EQL .DEPTH THEN RETURN;	! Already there!

    IF .SIXRP[0] GTR .DEPTH THEN RETURN ERROR(30);	! can't go back to deeper stack
    IF .UNWINDVALUE EQL 0 THEN RETURN ERROR(37);	! unwind will fail, don't do it
    ! do unwinding
    !
    WHACKS = .DEPTH - .SIXRP[0] + 1;	! how many levels to whack off

    SIGNAL( SIXUNWSIGNAL )
    END;
ROUTINE XPOP(N):NOVALUE=
    BEGIN
    LOCAL
	CNT;

    CNT = (IF .N EQL 0 THEN 1 ELSE .SIXRP[0]);

    IF .CNT GTR .DEPTH THEN CNT = .DEPTH;

    IF .DEPTH LEQ 1 THEN RETURN ERROR(29);	! no place to go back to
    IF .CNT EQL 0 THEN RETURN;			! already there!

    IF .CNT LSS 0
    THEN
	BEGIN
	CNT = (-.CNT) + .DEPTH;
	RETURN ERROR(30);		! can't go back to deeper stack
	END;

    IF .CNT GEQ .DEPTH THEN CNT = .DEPTH;

    IF .UNWINDVALUE EQL 0 THEN RETURN ERROR(37);	! Unwind will fail, don't do it!

    ! do unwinding
    !

    WHACKS = .CNT+1;				! how many levels to whack off

    SIGNAL( SIXUNWSIGNAL )
    END;
ROUTINE XSIGNAL:NOVALUE=
    BEGIN
    SIGNAL( .SIXRP[0] )
    END;
ROUTINE XSETUNWIND:NOVALUE=
    BEGIN
    SETUNWIND()
    END;
ROUTINE EXITSIGNAL(P,V,KIND):NOVALUE=
!+
! FUNCTION
!	This implements the RESUME and RESIGNAL commands
! INPUT
!	P	- Indicates parse to use, either NILADIC or PREFIX
!	V	- Value to leave in SIXRP[0]
!	KIND	- Is this RESUME or RESIGNAL
! OUTPUTS
!	None
!-
    BEGIN
    !	Here we see if our return address is in WithinSignalHandler
    !	If not, we do an Error(27)
    !
    LOCAL
	F	: $FRAME;

    F = .ENTERPNT;
    IF .F[NEXT_FRAME] NEQ 0 AND
	.F[NEXT_FRAME] LSS .F<RH>
    THEN
	F = .F[NEXT_FRAME]
    ELSE
	BEGIN
	ERROR(27);	! first failure...FREG will be at least
			! depth 2 in signal handler!
	RETURN
	END;

    IF NOT WITHINSIGNALHANDLER(GETCALLFROM(.F<RH>)) 
    THEN
	BEGIN
	ERROR(27);	! second failure...return address is
			! not to signal handler
	RETURN
	END;

    !	We now know that we are about to return to the signal
    !	handler.  First, we modify the value of the signal
    !	or return value if necessary

    IF .P						! MONADIC
    THEN
	BEGIN %(modify values)%
	LOCAL
	    S	: REF VECTOR;

	! Now, what we WANT here is that S=GetArgAdr(n,.F<RH>)
	! but since the signal handler doesn't follow strict
	! parameter passing protocols, GetArgAdr will fail.
	! However, by this point we KNOW that we are being called
	! from a signal handler routine, so the following code
	! will indeed return the correct address of the parameter
	IF .KIND EQL DORESUME THEN
	    BEGIN %(resuming)%
	    S = .F[ARG_N_OF_M(2,3)];		! get address of mechanism
						! vector
	    S[1] = .SIXRP[0];			! store return value
						! for signal call
	    END %(resuming)%;
	IF .KIND EQL DORESIGNAL THEN
	    BEGIN %(resignalling)%
	    S = .F[ARG_N_OF_M(1,3)];		! get address of first arg,
						! which is the signl vector
	    S[1] = .SIXRP[0];			! new value stored
	    END %(resignalling)%;
	END %(modify values)%;

    SIXRP[0] = .V;
    XRETURN()
    END;
ROUTINE XRESUME(P) : NOVALUE=
!+
! FUNCTION
!	This operator has two parses:
!		niladic: equivalent to the RETURN 1 command
!		monadic: sets the return value in the mechanism
!			vector to the value of SIXRP
!
!	This operator is valid only when in the signal handler
!	routine!
!
    BEGIN
    EXITSIGNAL(.P,1,DORESUME)
    END;
ROUTINE XRESIGNAL(P): NOVALUE=
!+
! FUNCTION
!	This operator has two parses:
!		niladic: equivalent to the RETURN 0 command
!		monadic: sets the signal value in the mechanism
!			vector to the value of SIXRP
!
!	This operator is valid only when in the signal handler
!	routine!
!-
    BEGIN
    EXITSIGNAL(.P,0,DORESIGNAL)
    END;
ROUTINE CALL1:NOVALUE=
!+
! FUNCTION
!	Implements the CALLS command
!-
    BEGIN
    OUTFLAG();
    PSTK( .ENTERPNT[NEXT_FRAME], 0,  BIGNUMBER )
    END;


ROUTINE CALL2:NOVALUE=
!+
! FUNCTION
!	Implement the LCALLS command
!-
    BEGIN
    OUTFLAG();
    PSTK( .ENTERPNT[NEXT_FRAME], 1, BIGNUMBER )
    END;


ROUTINE XCALL(K): NOVALUE=
!+
! FUNCTION
!	Implement the CALL or CALL <n> command
! INPUT
!	K	- indicates NILADIC or MONADIC parse
!-
    BEGIN
    OUTFLAG();
    PSTK( .ENTERPNT[NEXT_FRAME], 0, (IF .K THEN ..SIXRP ELSE 1) )
    END;


ROUTINE XLCALL(K): NOVALUE=
!+
! FUNCTION
!	Implement the LCALL and LCALL <n> commands
! INPUT
!	K	- Flag indicating NILADIC or MONADIC parse
!-
    BEGIN
    OUTFLAG();
    PSTK( .ENTERPNT[NEXT_FRAME], 1, (IF .K THEN ..SIXRP ELSE 1) )
    END;
ROUTINE ISADDRESS(P)=
!+
! FUNCTION
!	Is value an address in the user's address space?
! INPUTS
!	P	- Address value
! OUTPUT
!	True	- Valid address
!	False	- Non-existant memory
!-
    BEGIN
%IF TOPS10
%THEN
    IF .P<RH>  GTR .$JBREL<RH>	 AND	! not in lowseg
	.$JBHRL NEQ 0
    THEN
	IF .P<RH> GTR .$JBHRL<RH> OR
	   .P<RH>  LSS .$JBHRL<RH> - .$JBHRL<LH>
	THEN
	    RETURN 0;
    RETURN 1
%ELSE
    LOCAL
	PROTECTION;

    RPACS( $FHSLF^18 + (.P<RH>)^(-9) ; PROTECTION );

    (.PROTECTION AND (PA_CPY OR PA_PEX)) NEQ 0			! Does page exist?
%FI
    END;
ROUTINE ISREADABLE(P)=
!+
! FUNCTION
!	Check that the given address is "readable"
! INPUT
!	P	- address value
! OUTPUT
!	TRUE	- address can be read (no NXM trap will occur)
!	FALSE	- address is not mapped...
!-
    BEGIN
    LOCAL
	PAGENUM,
	PROTECTION;

%IF TOPS10
%THEN
    ISADDRESS(.P) 
%ELSE
    PAGENUM = (.P AND AddrMask)^(-9);

    RPACS( $FHSLF^18 OR .PAGENUM ; PROTECTION );

    (.PROTECTION AND PA_RD) NEQ 0
%FI
    END;
ROUTINE ISWRITABLE(P)=
!+
! FUNCTION
!	Determine if this address is writable.
! INPUTS
!	P	- Virtual address
! OUTPUTS
!	TRUE	- location may be written
!	FALSE	- location is non-writable
!-
    BEGIN
%IF TOPS10
%THEN
    RETURN 1
%ELSE
    LOCAL
	PAGENUM,
	PROTECTION;

    PAGENUM = (.P AND AddrMask)^(-9);
    RPACS( $FHSLF^18 OR .PAGENUM ; PROTECTION );

    (.PROTECTION AND (PA_WT OR PA_CPY)) NEQ 0	! Writable or copy on write...
%FI
    END;
ROUTINE ISROUTINE(P: REF $INSTRUCTION)=
!+
! FUNCTION
!	See if P is address of a BLISS routine.
! INPUT
!	P	- machine address of PDP-10/20 Instruction
! OUTPUT
!	0	- not a routine address
!	#0	- CH$PTR to descriptive text
!-
    BEGIN
    IF NOT ISREADABLE(.P) THEN RETURN 0;	! Location isn't addressable

    !+	
    ! It is certainly a routine if it contains any one of the
    ! instructions which start a routine, such as a DEBUG UUO
    !-
    SELECTONE .P[M_OPCODE] OF
	SET
	[DEBUGUUO]:
	    IF .P[0,NOVALUEBIT]
	    THEN
		RETURN MSG( 'NoValue Routine w/debug' )
	    ELSE
		RETURN MSG( 'Routine w/debug' );

	[PUSHOP,POPJOP,PUSHJOP]:
	    IF .P[M_REGF] EQL SREG
	    THEN
		RETURN MSG('Routine')
	    ELSE
		RETURN 0;

	[OTHERWISE]:
	    RETURN 0
	TES
    END;
ROUTINE PPSYM(P:SYMBOL, W):NOVALUE=	! Common code for PRS, SEARCH, PRM
!+
! FUNCTION
!	Formatted dump of selected portions of the symbol table.  Used by
!       PRS, PRM and SEARCH commands.
! INPUTS
!	P	- Pointer to symbol-table entry
!	W	- Width of symbol-name printed. (Used to align columns)
!-
    BEGIN
    LOCAL
	T,		      ! Pointer to a text string
	S;			! Count of symbols in a module

    IF .P[INVALIDFLAG]		! Smashed symbols get "*" to indicate
    THEN			!  no valid binding
	BEGIN
	OUTC(%C'*');
	W = .W + 1
	END;

    DECR I FROM 9-.W TO 0 DO OUTC(%C' ');

    IF .P[RAD50FLAG] NEQ DDT$_MODULE		! Not a module
    THEN
	OUTRDEF(.P[VALUEWRD],12);		! Display 36 bit value

    PUTTAB;

    CASE .P[RAD50FLAG] FROM DDT$_MODULE TO DDT$_OWN OF
	SET
	[DDT$_MODULE]:
		BEGIN				! Show addr of module base
		S = -.P[SYMBOLCNT];		! Get count of symbols
		OUTRDEF(.P[SYMBOLVAL],12);

		IF .P<RH> EQL .GQUALIFIER<RH>
		THEN
		    OUTC(%C'\')
		ELSE
		    OUTC(%C' ');
		OUTS('Module');
		PUTTAB;  PUTTAB;
		OUTDR(.S/2, 5);
		OUTS(' symbols');
		CRLF;
		RETURN
		END;

	[DDT$_GLOBAL]:
		OUTS(' Global');
	[DDT$_OWN]:
		OUTS(' Own');
	[OUTRANGE]:
		(CRLF; RETURN)
	TES;


    PUTTAB;  
    PRSYM50(MODDDT(.P)); 
    IF (T=ISROUTINE(.P[ADDRWRD])) NEQ 0
    THEN
	BEGIN
	PUTTAB;
	OUTSA(.T)
	END
    ELSE
	IF ISREADABLE(.P[ADDRWRD])
	THEN
	    BEGIN
	    PUTTAB;
	    OUTDEFAULT(.(.P[ADDRWRD]) );
	    IF (.P[RAD50NAME] / (%O'50'*%O'50'*%O'50')) EQL %RAD50_10 'P.'
		AND .(.P[VALUEWRD]) LSS 0 
		AND NOT .(.P[VALUEWRD])
	    THEN
		!+
		! Heuristics implying that the above is a "BIND" to a string
		! literal value
		!-
		BEGIN
		LOCAL
		    T,
		    C;

		T = CH$PTR(.P[ADDRWRD]);
		PUTTAB;
		OUTC(%C'''');
		INCR I FROM 0 TO 8 DO
		    BEGIN 
		    C = CH$RCHAR_A(T);
		    IF .C EQL 0 THEN EXITLOOP;
		    IF .C GEQ %C' '
		    THEN
			OUTC(.C)
		    ELSE
			BEGIN
			OUTC(%C'?');
			OUTC(.C+%O'100');
			END;
		    END;
		IF .C NEQ 0 THEN OUTS('...');
		OUTC(%C'''');
		END %(string? )%
	    ELSE
		IF .(.P[ADDRWRD]) GTR %O'40' AND
		    .(.P[ADDRWRD]) LSS %O'177'
		THEN				! Single ASCII character
		    BEGIN
		    PUTTAB;
		    OUTC(%C'"');
		    OUTC(.(.P[ADDRWRD]));
		    OUTC(%C'"')
		    END;
	END;

    CRLF
    END;
ROUTINE PRS:NOVALUE=
!+
! FUNCTION
!	Implements the PRS command
!	Prints all symbols which have the same name as the input.
!
!-
    BEGIN
    INCR I FROM 0 TO .SIXRC-1 DO
	BEGIN
	LOCAL
	    NAME,				! SIXBIT name to look up
	    P	: SYMBOL,			! Matching symbol
	    W;					! Field-width printed

	P = 0;					! Initially no symbols found
	NAME = .SIXRP[.I];			! Get next sixbit name

	INCR J FROM 1 DO
	    BEGIN
	    IF (P = NSDDTFA(.NAME,.P)) EQL 0
	    THEN
		BEGIN
		IF .J EQL 1
		THEN
		    (TTOUTS('No entry for ');  PRSYM50(.NAME);  CRLF);
		EXITLOOP
		END;

	    W = PRSYM50(.NAME);
	    IF .P[RAD50FLAG] NEQ DDT$_MODULE	! Print postfix numeric
	    THEN				!  qualification for any
		BEGIN				!  duplicated name.
		OUTC(%C'%');
		W = .W + 1;
		W = .W + OUTDEFAULT(.J)
		END
	    ELSE
		! Do not count module names in %-qualification
		J = .J -1;

	    PPSYM(.P,.W)
	    END
	END
    END;
ROUTINE PRMS(SYM,SYMNAME,CHAR): NOVALUE=
!+
! FUNCTION
!	Implement the PRM Command [ PRint Module ]
! INPUTS
!	Sym	- The symbol table to use
!	SymName	- The module name to print out, or 0 if all modules
!	Char	- the prefix character to use, either SPACE [LOWSEG] or
!		  UPARROW ("^") [HISEG]
!-
    BEGIN
    LOCAL
	R	: SYMBOL;

    R = - .SYM<LH,1>;
    R = (.R^18) + .R + .SYM<RH>;

    WHILE (R = .R-%O'2000002') GEQ 0 DO
	BEGIN
	IF .R[RAD50FLAG] EQL DDT$_MODULE
	THEN
	    BEGIN  %(have module name)%
	    IF .SYMNAME EQL 0 OR		! All modules
		.R[RAD50NAME] EQL .SYMNAME	!  or this specific one
	    THEN
		BEGIN %(want this one)%
		LOCAL
		    ME, 	    ! My module name
		    C;

		OUTC(.CHAR);
		C = PRSYM50(ME = .R[RAD50NAME]);
		PPSYM(.R<RH>,.C);
		IF .SYMNAME NEQ 0
		THEN
		    BEGIN %(names in module)%
		    LABEL DONAME;
		    WHILE (R = .R-%O'2000002') GEQ 0 DO
DONAME:			BEGIN %(print names)%
			LABEL CHECK;
			IF .R[RAD50FLAG] EQL DDT$_MODULE THEN RETURN;
			IF .R[RAD50NAME] EQL (%RAD50_10 '%%%%%%')+1
			THEN
			    LEAVE DONAME; ! Don't print suppressed SIX12 symbols
			OUTC(.CHAR);
			C = PRSYM50(.R[RAD50NAME]);
			PPSYM(.R<RH>,.C);

			! Now, do something about checking lowseg
			! consistency

			IF ISHIGHSYMBOLTABLE()
			THEN
CHECK:			    BEGIN %(check)%
			    LOCAL
				L	: SYMBOL,
				M	: SYMBOL;

			    IF .SYM NEQ .HCACHE OR .R[ADDRWRD] GEQ .IJOBHSM
			    THEN
				LEAVE CHECK; 		! symbol is in hiseg

			    M = - .$JBSYM<LH,1>;
			    M = (.M^18) + .M + .$JBSYM<RH>;

			    WHILE (M = .M- %O'2000002') GEQ 0 DO
				BEGIN %(scan lowseg for module)%
				IF .M[RAD50FLAG] EQL DDT$_MODULE AND
				   .M[RAD50NAME] EQL .ME
				THEN
				    EXITLOOP;
				END;
	    
			    IF .M LEQ 0 THEN LEAVE CHECK;	! module not in lowseg
			    L = NSDDTW(.R[RAD50NAME], .M, .$JBSYM);
			    IF .L[VALUEWRD] NEQ .R[VALUEWRD]
			    THEN
				PPSYM(.L<RH>,0)
			    END %(check)%;
			END %(print names)%;
		    END %(names in module)%;
		END %(Want this one)%;
	    END %(have module name)%;
	END;
    END;
ROUTINE PRM:NOVALUE=
!+
! FUNCTION
!	Null: Print out all module names
!	Prefix: Print out all symbols in module names given
!-
    BEGIN
    IF .SIXRC EQL 0
    THEN
	BEGIN
	IF ISHIGHSYMBOLTABLE() THEN PRMS(.HCACHE,0,%C'^');
	PRMS(.$JBSYM, 0,%C' ')
	END
    ELSE
	BEGIN %(just what we asked for)%
	INCR I FROM 0 TO .SIXRC-1 DO
	    BEGIN %(see if requested)%
	    IF ISHIGHSYMBOLTABLE()
	    THEN
		PRMS(.HCACHE, .SIXRP[.I], %C'^');

	    PRMS(.$JBSYM, .SIXRP[.I], %C' ')
	    END
	END
   END;
ROUTINE QUAL : NOVALUE=
!+
! FUNCTION
!	Set up default qualification value for symbol table lookups
!-
    BEGIN
    MAP
	GQUALIFIER	: SYMBOL;
    LOCAL
	S;

    IF .SIXRC EQL 0
    THEN
	BEGIN %(print out)%
	IF .GQUALIFIER EQL 0
	THEN
	    BEGIN
	    OUTS('No default module name');
	    OUTCRLF();
	    RETURN
	    END;

	! otherwise, the GQualifier points to the module name
	! entry
	IF ISHIGHSYMBOLTABLE()
	THEN
	    IF .HQUALIFIER NEQ .HCACHE
	    THEN
		BEGIN
		GQUALIFIER = 0;
		HQUALIFIER = .$JBSYM;
		ERROR(36);
		RETURN;
		END;
	    PRSYM50(.GQUALIFIER[RAD50NAME]);
	    OUTCRLF();
	    RETURN
	END %(print out)%;

    S = FINDMODULE(.SIXRP[0]);
    IF .S EQL 0 THEN RETURN ERROR(0);

    GQUALIFIER = .S;
    IF ISHIGHSYMBOLTABLE()
    THEN
	IF .S<RH> GEQ .HCACHE<RH>
	THEN
	    HQUALIFIER = .HCACHE
	ELSE
	    HQUALIFIER = .$JBSYM
    END;
ROUTINE XQUAL:NOVALUE=
!+
! FUNCTION
!	Push QUALIFY operator onto DBGSTK
!-
    BEGIN
    QUOTFLG = BIGNUMBER;
    PUSHOPER(4^18 + (UPLIT(10^18+QUAL, 10^18+QUAL, 0,0)))
    END;
ROUTINE HSEARCH(SYM : SYMBOL, CHAR):NOVALUE=
!+
! FUNCTION
!	Search under mask for symbols.  This implements the semantics of the
!		SEARCH "aaa???"
!	command
! INPUTS
!	SYM	- Symbol Table pointer (to MODULE?)
!	CHAR	- ??
!-
    BEGIN
    LABEL
	L;
    LOCAL
	ALPHA,					! A character temporary
	P	: SYMBOL,
	NAME:	VECTOR[6],
	TNAME:	VECTOR[6],
	CNT,
	W,
	TPTR,
	TCNT,
	R50NAME;

    CNT = -1;
    TPTR = CH$PTR( .SIXRP );

    WHILE (ALPHA = CH$RCHAR_A(TPTR)) NEQ 0 DO
	IF .CNT LSS 5
	THEN
	    NAME[(CNT = .CNT+1)] = (IF .ALPHA EQL %C'?'
				    THEN
					0
				    ELSE
					F7TO50(.ALPHA))
	ELSE
	    EXITLOOP;					! Seen enough chars

    P = - .SYM<LH,1>;
    P = .P^18 + .P + .SYM<RH>;

    WHILE (P = .P-%O'2000002') GEQ 0 DO
L:	BEGIN
	R50NAME = .P[RAD50NAME];

	TCNT = (DECR X FROM 5 TO 0 DO
		BEGIN
		TNAME[.X] = .R50NAME MOD %O'50';
		IF (R50NAME = .R50NAME / %O'50') EQL 0 THEN EXITLOOP .X
		END);

	IF 5-.TCNT GTR .CNT THEN LEAVE L;	! Wrong # of characters
	INCR X FROM 0 TO .CNT DO		! Check for equality under
	    BEGIN				!  masking
	    IF .NAME[.X] NEQ 0 AND .NAME[.X] NEQ .TNAME[.TCNT]
	    THEN
		LEAVE L;
	    TCNT = .TCNT+1
	    END;

	OUTC(.CHAR);
	W = PRSYM50(.P[RAD50NAME]);
	PPSYM(.P,.W)
	END;
    END;
ROUTINE XSEARCH: NOVALUE=		! ? SEARCH FEATURE
    BEGIN
    IF ISHIGHSYMBOLTABLE() THEN HSEARCH(.HCACHE,%C'^');

    HSEARCH(.$JBSYM, %C' ')
    END;
ROUTINE XWHERE:NOVALUE=
!+
! FUNCTION
!	Given an address, indicate which module the address can be found in.
!-
    INCR I FROM 0 TO .SIXRC-1 DO
	BEGIN
	LOCAL
	    S;

	S = .SIXRP[.I];
	OUTRDEF(.S<RH>,6);
	IF ISADDRESS(.S<RH>)
	THEN
	    BEGIN
	    OUTS(': Module ');
	    PRSYM50(MODDDT(SDDTFS(.S)));
	    OUTS(', ');
	    PRDISP(.S<RH>)
	    END
	ELSE
	    OUTS(': Not in address space');

	OUTCRLF()
	END;
ROUTINE XRETURN: NOVALUE=
!+
! FUNCTION
!	Implement the "RETURN <exp>" command
!-
    BEGIN
    IF .RTNLVL EQL 0
    THEN
	!+
	! Returning while at routine-entry.  So we must locate the DEBUG UUO
	! marking the exit sequence and resume execution there.
	!-
	BEGIN
	LOCAL
	    L	: REF $INSTRUCTION;
	MACRO
	    POPADR= ENTERPNT[RET_ADDRESS] %;

	L = FNDDBGUUO(.$JBUUO,1);

	IF .L LEQ 0 THEN (PRXDISP(.POPADR);  RETURN ERROR(6));

	! if we found the DEBUG unwind,rtn UUO and we are NOT at
	! then unwind, we want to exit via the standard exit code
	!

	IF .L[0,UNWINDBIT] AND .L<RH> NEQ .RNAME
	THEN
	    BEGIN
	    L = FNDDBGUUO(.L+1,1);
	    IF .L LEQ 0 THEN (PRXDISP(.POPADR); RETURN ERROR(6));
	    END;
	POPADR = .L+1			! Advance to next instruction
	END;
    SIXVREG = .SIXRP[0];		! Set returned value
    GOER()
    END;
ROUTINE XDEL2:NOVALUE=
!+
! FUNCTION
!	Delete a name from the SIX12 "MACRO" table
! NOTES
!	Space for name is recovered, but space for definition is not.
!-
    BEGIN
    DECR J FROM .SIXRC-1 TO 0 DO
	BEGIN
	LOCAL
	    PNT;

	! Lookup name in the macro-definition table
	!

	PNT = (DECR K FROM .NNAMES TO 0 DO
		IF .SIXRP[.J] EQL .SIXNAMES[.K,MACRO_NAME] THEN EXITLOOP .K);

	IF .PNT GEQ 0
	THEN 
	    BEGIN				! Found the name
	    IF .PNT LSS .NNAMES
	    THEN
		BEGIN
		SIXNAMES[.PNT,MACRO_NAME] = .SIXNAMES[.NNAMES,MACRO_NAME];
		SIXNAMES[.PNT,MACRO_BODY] = .SIXNAMES[.NNAMES,MACRO_BODY]
		END;
	    NNAMES = .NNAMES-1
	    END
	END;
    END;
ROUTINE XDEL1:NOVALUE=
!+
! FUNCTION
!	COMMAND: FORGET name ,...
!
!	CREATE OPERATOR FOR EXECUTION AFTER LIST of NAMES IS BUILT.
!-
    BEGIN
    QUOTFLG = BIGNUMBER;
    PUSHOPER(4^18 + UPLIT(0, 10^18+XDEL2, 0, 0))
    END;

MACRO
    APPLY(OP)=
	BEGIN
	SIXVC = .SIXVC+1;
	SIXVP = VTEMP;
	VTEMP = ..SIXLP OP ..SIXRP;
	END %,

    ONEAPPLY(OP)=
	BEGIN
	SIXVC = .SIXVC+1;
	SIXVP = VTEMP;
	VTEMP = OP ..SIXRP;
	END %;
ROUTINE XADD: NOVALUE=APPLY(+);

ROUTINE XSUBTRACT(K): NOVALUE=IF .K LSS 2 THEN ONEAPPLY(-) ELSE APPLY(-);

ROUTINE XTIMES: NOVALUE=APPLY(*);

ROUTINE XDIV: NOVALUE =APPLY(/);

ROUTINE XSHIFT:NOVALUE= APPLY(^);

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

ROUTINE XAND:NOVALUE=APPLY(AND);
ROUTINE XEQOR:NOVALUE=APPLY(OR);
ROUTINE XNOT:NOVALUE=ONEAPPLY(NOT);
ROUTINE CONTENTS:NOVALUE=
!+
! FUNCTION
!	Fetch contents of specified location.
!
!	Location is implicitly supplied thru SIXRP
!-
    BEGIN
    MAP
	SIXRP	: REF $BYTE_POINTER;

    IF	(.SIXRP[P_POS] + .SIXRP[P_SIZE]) GTR 36 OR	! Validate that the
	.SIXRP[P_INDEX] NEQ 0				!  pointer is "sane"
    THEN
	(PRBPTR(..SIXRP);  RETURN ERROR(18));

    IF NOT ISADDRESS(..SIXRP)
    THEN
	BEGIN
	ILLMEM = ..SIXRP AND AddrMask;
	ERROR(28);
	RETURN
	END;
    IF NOT ISREADABLE(..SIXRP)
    THEN
	BEGIN
	ILLMEM = ..SIXRP;
	ERROR(33);
	RETURN
	END;

    SIXVC = 1;
    SIXVP = VTEMP;

    IF .SIXRP[P_LHALF] EQL 0
    THEN
	VTEMP = ..SIXRP[0,FW]		! Do 36-bit load
    ELSE
	VTEMP = SCANN(SIXRP[0,FW])	! Get value using LDB
    END;
ROUTINE XFUTURE : NOVALUE=
!+
! FUNCTION
!	Indicate that "@" is reserved for FUTURE use.  Probably as
!	a 30-bit addressing operator of some flavor.
!-
    BEGIN
    ERROR(38)
    END;
ROUTINE COLON:NOVALUE=
!+
!	LG change
!-
    BEGIN
    ERROR(1);		! illegal character;
    END;


ROUTINE SYNTAX=ERROR(2);
ROUTINE LGFLD:NOVALUE = ERROR(1);

ROUTINE LGVEC:NOVALUE = ERROR(2);	! syntax error
ROUTINE JOIN:NOVALUE=			! BINARY COMMA (CATENATION)
!+
! FUNCTION
!	"Binary" Comma - CATENATION Operator
!-
    BEGIN
    INCR J FROM 0 TO .SIXRC-1 DO
	SIXLP[.SIXLC +.J] = .SIXRP[.J];

    SIXVP = .SIXLP;
    SIXVC = .SIXLC + .SIXRC
    END;
ROUTINE LPAREN=			! Routine CALL
!+
! FUNCTION
!	Implement procedure calls
!-
    BEGIN
    LOCAL
	SCOUNT,
	SAVEGO,
	SAVJBUUO,
	SAVESTEP,
	SAVETRACE;
    OWN
	ARGCOUNT;		! Must be Own for stack trace to find

    SCOUNT = .ARGCOUNT;
    SAVEGO = .GOFLAG;
    SAVESTEP = .STEPFLAG;
    SETOFF(STEPFLAG);

    SAVETRACE = .TRACEFLAG;

    IF ISON(COPQFLAG) THEN SETOFF(TRACEFLAG);

    SAVJBUUO = .$JBUUO;
    GOFLAG = 1;					! Don't stop in routine

    ARGCOUNT = .SIXRC^18 + .SIXRC;		! SAVE # of PARMS

    !**********************************************************************

    CODECOMMENT	'This is very dangerous code':
	BEGIN
	BUILTIN
	    SP;

	INCR I FROM 0 TO .SIXRC-1 DO		! PUSH PARMS
	    PUSH(SP, SIXRP[.I]);
	(..SIXLP) ();	 			! THIS IS IT!

	SP = .SP - .ARGCOUNT;
    
	VTEMP = .VREG				! MUST BE AFTER STACK SUBTRACT
	END;
    !**********************************************************************

    $JBUUO = .SAVJBUUO;
    STEPFLAG = .SAVESTEP;
    TRACEFLAG = .SAVETRACE;
    GOFLAG = .SAVEGO;
    ARGCOUNT = .SCOUNT;
    SIXVC = 1;
    SIXVP = VTEMP;
    HCACHE = 0			! Clear cache, since user could call a
				! segment swapper
    END;
ROUTINE FIELDSPEC:NOVALUE=
!+
! FUNCTION
!	Evaluate ADDR<P,S> expression, forming a byte-pointer as the
!	result.
!-
    BEGIN
    LOCAL
	R	: $BYTE_POINTER;
    MAP
	SIXVP	: REF $BYTE_POINTER;

    IF .SIXRC NEQ 2 THEN RETURN ERROR(3);	! Insufficient arguments

    R = 0;
    R[P_POS] = .SIXRP[0];			 ! Set up position and
    R[P_SIZE] = .SIXRP[1];			 !  field values in byte-ptr

    SIXVP = .SIXLP;
    SIXVC = 1;

    SIXVP[P_LHALF] = .R[P_LHALF];	! Set into LH of addr word

    IF	.SIXRP[0] GTRU %O'77' OR		! Complain about deformed
	.SIXRP[1] GTRU %O'77'			!  pointer values.
    THEN
	BEGIN
	PRDISP(.(.SIXLP)<RH>);			! Print the displacement
	OUTC(%C'<');				!  and the suspicious
	OUTFD(.SIXRP[0]);			!  position and size
	OUTC(%C',');				!  values
	OUTFD(.SIXRP[1]);
	OUTC(%C'>');
	ERROR(18)
	END
    END;
ROUTINE STRUCT:NOVALUE=
!+
! FUNCTION
!	Fake structure accesses
! INPUTS
!	SIXLP	->	Base expression value
!
!	SIXRC	- Indicates if we are doing a VECTOR or a BLOCK
!		  reference
!-
    BEGIN
    LOCAL
	R;
    MAP
	SIXVP   : REF $BYTE_POINTER;

    ! Check for correct number of access actuals in reference.  Either
    ! one (for VECTOR) or 3 for BLOCK is correct.  All others are suspect.

    IF .SIXRC EQL 2 OR .SIXRC GTR 4 THEN RETURN ERROR(3);

    SIXVP = .SIXLP<RH>;
    IF .SIXREF THEN SIXVP[0,FW] = ..SIXVP[0,FW];	! Implicit REF is "on"

    SIXVP[P_OFFSET] = .SIXVP[P_OFFSET] + .SIXRP[0];	! Include OFFSET value

    SIXVC = 1;

    IF .SIXRC GTR 1
    THEN
	BEGIN
	SIXVP[P_POS] = .SIXRP[1];	! Get position and
	SIXVP[P_SIZE] = .SIXRP[2]	!  size in byte-ptr
	END
    END;
%SBTTL'File service routines for SAVE and LOAD commands'

LITERAL
	BINARYMODE=0,
	ASCIIMODE=1;

ROUTINE INTEXT:NOVALUE=
    BEGIN
    LOCAL
	W;

    WHILE ISOFF(ERRORFLAG) DO
	BEGIN
	IF (W = INWORD()) EQL 0 THEN RETURN;

	.PTEXT = .W;
	PTEXT = .PTEXT+1;
	IF .PTEXT<RH> GEQ TEXTAREA[2*NMACROS] THEN RETURN ERROR(12)
	END
    END;
ROUTINE OUTTEXT(POINT):NOVALUE=
    BEGIN
    INCR PTR FROM .POINT<RH> DO
	BEGIN
	OUTWORD(..PTR);
	IF .(.PTR)<29,7> EQL %O'177' THEN EXITLOOP;
	IF .(.PTR)<22,7> EQL %O'177' THEN EXITLOOP;
	IF .(.PTR)<15,7> EQL %O'177' THEN EXITLOOP;
	IF .(.PTR)<8,7> EQL %O'177' THEN EXITLOOP;
	IF .(.PTR)<1,7> EQL %O'177' THEN EXITLOOP
	END;
    OUTWORD(0)
    END;
ROUTINE FILEOPEN(ISINPUT,MODEFLAG)=
    BEGIN
%IF TOPS10
%THEN
    LOCAL
	BLOCK:		VECTOR[4],
	OPENBLOCK:	VECTOR[4],
	TPPNBUF:	VECTOR[2],
	BP,
	PTR,
	I,
	C;

    MACRO
	ASCIITOSIX(C)=(((C)-%O'40') AND %O'77') %,
	TPPN=I %;

    ROUTINE CMUDEC(PTR)=
	BEGIN
	REGISTER
	    PPNVAL;

	PPNVAL = .PTR<RH>;
	IF NOT MACHSKIP(%O'47', PPNVAL, -2)	! CMU to DEC PPN conversions
	THEN
	    RETURN 0;

	.PPNVAL
	END;

    ROUTINE UPCASE(CHR) =
	SELECTONE .CHR OF
	    SET
	    [%C'a' TO %C'z']:	.CHR -%o'40';
	    [OTHERWISE]:	.CHR
	    TES;

    ROUTINE XTYP(C)=
	SELECTONE .C OF
	    SET
	    [0]:		0;
	    [%C' ']:		1;
	    [%C'.']:		2;
	    [%C'[']:		3;
	    [%C'A' TO %C'Z']:	4;
	    [%C'a' TO %C'z']:	4;
	    [%C'0' TO %C'9']:	4;
	    [%C':']:		5;
	    [OTHERWISE]:	6
	    TES;

    LABEL
	LB;

    STATUS = (IF .MODEFLAG EQL BINARYMODE THEN $IOIMG ELSE $IOASC);

    LDEV = %SIXBIT 'DSK';
    BUFW = (IF ISON(ISINPUT) THEN DSKHDR ELSE DSKHDR^18);

    IF NOT OPEN(SLCHN,OPENBLOCK) THEN RETURN ERROR(10);

LB:
    BEGIN
    FNAME =  JUNK = PPN = 0;
    FEXT = %SIXBIT '612';
    PTR = CH$PTR( .SIXRP );
    SIXRP[.SIXRC] = 0;			! GUARANTEE asciz STRING
    BP = CH$PTR( FNAME, 0, 6 );		! Set up SIXBIT pointer
    I = 6;

    WHILE 1 DO
	BEGIN			! GET FILENAME
	C = UPCASE(CH$RCHAR_A( PTR ));

	CASE XTYP(.C) FROM 0 TO 6 OF
	    SET
	    [0]:	LEAVE LB;
	    [1]:	0;
	    [2]:	EXITLOOP;
	    [3]:	EXITLOOP;
	    [4]:	IF (I = .I-1) GEQ 0
			THEN
			    CH$WCHAR_A(ASCIITOSIX(.C), BP);
	    [5]:	BEGIN
			LDEV = .FNAME;
			RELEASE(SLCHN);
			IF NOT OPEN(SLCHN,OPENBLOCK) THEN RETURN ERROR(10);
			FNAME = 0;
			BP= CH$PTR(FNAME, 0, 6);
			I=6
			END;
	    [6]:	RETURN ERROR(9)
	    TES
	END;

    IF .C EQL %C'.'
    THEN
	BEGIN			! GET EXTENSION
	BP = CH$PTR( FEXT, 0, 6 );
	FEXT = 0;
	I = 3;
	WHILE 1 DO
	    BEGIN
	    C = UPCASE( CH$RCHAR_A( PTR ) );

	    CASE XTYP(.C) FROM 0 TO 6 OF 
		SET
		[0]:    LEAVE LB;
		[1]:    0;
		[2]:    RETURN ERROR(9);
		[3]:    EXITLOOP;
		[4]:    IF (I = .I-1) GEQ 0
			THEN
			    CH$WCHAR_A(ASCIITOSIX(.C), BP);
		[5]:    RETURN ERROR(9);
		[6]:    RETURN ERROR(9)
		TES
	    END
	END;
    IF .C EQL %C'['
    THEN
	BEGIN			! GET PPN
	IF (I = .PTR;  CH$RCHAR_A(I)) GTR %C'7'
	THEN
	    BEGIN			! CMU PPN
	    BP = CH$PTR( TPPNBUF );
	    DECR I FROM 7 TO 0 DO
		BEGIN
		LOCAL
		    TCH;

		TCH = CH$RCHAR_A( PTR );
		CH$WCHAR_A( .TCH, BP );
		IF .TCH EQL %C']' THEN RETURN ERROR(9)
		END;

	    IF CH$RCHAR_A(PTR) NEQ %C']' THEN RETURN ERROR(9);
	    IF (PPN = CMUDEC(TPPNBUF)) EQL 0 THEN RETURN ERROR(9)
	    END
	ELSE
	    BEGIN			! OCTAL PPN
	    TPPN = 0;
	    WHILE (C = CH$RCHAR_A(PTR)) NEQ %C']' DO
		IF .C EQL %C','
		THEN ((PPN)<LH> = .TPPN;  TPPN = 0)
		ELSE
		    IF .C GEQ %C'0' AND .C LEQ %C'7'
		    THEN (TPPN = .TPPN^3 + .C - %C'0')
		    ELSE RETURN ERROR(9);
	    (PPN)<RH> = .TPPN
	    END 
	END
    END;		! of DUMMY BLOCK

    IF ISON(ISINPUT)
    THEN
	(IF NOT LOOKUP(SLCHN,BLOCK) THEN RETURN ERROR(10); INBUF(SLCHN,2))
    ELSE
	(IF NOT ENTER(SLCHN,BLOCK) THEN RETURN ERROR(10); OUTBUF(SLCHN,2));

%ELSE
    LOCAL
	JFN,
	ACMODE;

    SIXRP[.SIXRC] = 0;				! Guarantee ASCIZ string

    ACMODE = (IF .MODEFLAG EQL BINARYMODE THEN 36^30 ELSE 7^30);

    IF ISON(ISINPUT)
    THEN
	BEGIN
	IF NOT GTJFN( GJ_OLD+GJ_SHT, CH$PTR(.SIXRP); JFN)
	THEN
	    RETURN ERROR(10);			! OPEN FAILURE

	DSKHDR = .JFN<RH>;

	IF NOT OPENF( .JFN, .ACMODE+OF_RD ) THEN RETURN ERROR(10)
	END
    ELSE
	BEGIN
	IF NOT GTJFN( GJ_NEW+GJ_SHT+GJ_FOU, CH$PTR(.SIXRP) ; JFN )
	THEN
	    RETURN ERROR(10);			! Open failure	    

	DSKHDR = .JFN<RH>;

	IF NOT OPENF( .JFN, .ACMODE + OF_WR ) THEN RETURN ERROR(10)
	END;

%FI
    1
    END;
ROUTINE XSAVE: NOVALUE=
!+
! FUNCTION
!	Implement the SAVE command to dump the "internal" state of
!	SIX12, including user defined macros, operators, etc..
!-
    BEGIN
%IF TOPS10
%THEN
    LOCAL
	SAVFF;

    SAVFF = .$JBFF;		! Remember memory high-water mark
%FI

    !+
    ! Open the output file
    !-
    IF NOT FILEOPEN(0,BINARYMODE) THEN RETURN;	! You lose....

    SETOFF(ERRORFLAG);
    OUTWORD(.SIXTOG);
    OUTWORD(.SIXREF);
    OUTWORD(.COPQFLAG);
    OUTWORD(.GQUALIFIER);		! Note that we do not worry
					! about overlaid hiseg, as binary
					! save assumes reload in current
					! state...but we do save...
    OUTWORD(.HQUALIFIER);
    INCR J FROM 0 TO .NVALS DO
	BEGIN				! OUTPUT A MONITOR ENTRY
	OUTWORD(.MONVALS[.J,WATCHED_LOCATION]);
	OUTWORD(.MONVALS[.J,WATCHED_VALUE])
	END;
    OUTWORD(-1);			! end of MONITORS

    INCR J FROM 0 TO .NNAMES DO
	BEGIN				! OUTPUT A Macro
	OUTWORD(.SIXNAMES[.J,MACRO_NAME]);
	OUTTEXT(.SIXNAMES[.J,MACRO_BODY])
	END;
    OUTWORD(-1);			! end of MACROS

    INCR J FROM 0 TO .NROUTS DO
	BEGIN				! OUTPUT A Routine ENTRY
	BIND
	    ENTRY = ROUTS[.J,0,FW]: BLOCK;	! Number of actions associated
						!  with this routine

	OUTWORD(.ENTRY[0,0,MAXACTRTN,0]);	! Interest bits and routine
	DECR SUB FROM MAXACTRTN TO 18 DO	! Dump conditional actions
	    BEGIN				!  for each event
	    IF .ENTRY[INTEREST(.SUB)]		! This is interesting event
	    THEN
		IF .ENTRY[CNDACTION(.SUB)] NEQA 0	! With conditional text
		THEN
		    OUTTEXT(.ENTRY[CNDACTION(.SUB)])
		ELSE
		    OUTWORD(0)
	    END
	END;

    OUTWORD(-1);

%IF TOPS10
%THEN
    IF ISON(ERRORFLAG)
    THEN
	(ERROR(11);  CLOSE(SLCHN, CL$RST))	! Close, but don't enter into
    ELSE					!  user's directory
	CLOSE(SLCHN,0);
    RELEASE(SLCHN,0);
    $JBFF = .SAVFF;
%ELSE
    CLOSF( .DSKHDR );
%FI
    0
    END;
ROUTINE XLOAD:NOVALUE=
!
! COMMAND
!
    BEGIN
    LOCAL
	W,
	W2,
	SAVFF;

%IF TOPS10 %THEN SAVFF = .$JBFF; %FI

    IF NOT FILEOPEN(1,BINARYMODE) THEN RETURN;

    SETOFF(ERRORFLAG);
    NVALS = NNAMES = NROUTS = -1;
    PTEXT = CH$PTR( TEXTAREA );
    SIXTOG = INWORD();		! *** These must match exactly with XSTORE
    SIXREF = INWORD();		! ***
    COPQFLAG = INWORD();	! ***
    GQUALIFIER = INWORD();	! ***
    HQUALIFIER = INWORD();	! ***

    WHILE (W = INWORD()) NEQ -1 DO
	BEGIN						! Get MONITOR entries
	MONVALS[(NVALS = .NVALS+1),WATCHED_LOCATION] = .W;
	MONVALS[.NVALS,WATCHED_VALUE] = INWORD()
	END;

    WHILE (W = INWORD()) NEQ -1 DO
	BEGIN						! RETRIEVE Macro
	IF .NNAMES GEQ NMACROS
	THEN
	    EXITLOOP ERROR(13);

	SIXNAMES[(NNAMES = .NNAMES+1),MACRO_NAME] = .W;
	SIXNAMES[.NNAMES,MACRO_BODY] = .PTEXT<RH>;
	INTEXT();
	IF ISON(ERRORFLAG) THEN EXITLOOP;
	END;

    WHILE (W = INWORD()) NEQ -1 DO
	BEGIN						! Get Routine entries
	LOCAL
	    SAVERR;

	SAVERR = .ERRORFLAG;
	ROUTS[(NROUTS = .NROUTS+1),0,FW] = .W;

	! We do not want to include the TABREAKV bit in these tests...
	!
	IF (.W AND (BREAKV+OPQATV+OPQAFTV+TRCATV+TRCAFTV)) NEQ 0
	THEN
	     SETTBLBIT(.W<RH>,0);
	IF (.W AND (ABREAKV+OPQATV+OPQAFTV+TRCATV+TRCAFTV)) NEQ 0
	THEN
	    SETTBLBIT(.W<RH>,1);
	ERRORFLAG = .SAVERR;		! Ignore errors from SETTBLBIT Routine
	
	DECR SUB FROM MAXACTRTN TO 18 DO
	    BEGIN
	    MAP
		W:	BLOCK[1];	! Only ACTION bits are valid here

	    IF .W[INTEREST(.SUB)]		! Interesting event
	    THEN
		BEGIN
		IF (W2 = INWORD()) NEQ 0
		THEN
		    BEGIN					! Get ptr for
		    ROUTS[.NROUTS, CNDACTION(.SUB)] = .PTEXT;	!  string area
		    (.PTEXT) = .W2;			! Save 1st chars
		    PTEXT = .PTEXT+1;			!  and advance pointer
		    INTEXT()				! Get remaining chars
		    END
		ELSE
		    ROUTS[.NROUTS, CNDACTION(.SUB)] = 0;	! No conditional text
		END
	    ELSE
		ROUTS[.NROUTS, CNDACTION(.SUB)] = 0
	    END
	END;

    IF ISON(ERRORFLAG) THEN (NVALS = NNAMES = NROUTS = -1;  ERROR(11));

%IF TOPS10
%THEN
    CLOSE(SLCHN,0);
    RELEASE(SLCHN,0);
    $JBFF = .SAVFF;
%ELSE
    CLOSF( .DSKHDR );
%FI
    END;
ROUTINE OUTOP(J,T):NOVALUE=
!+
! FUNCTION
!	Utility routine used by XSTORE to reduplicate the command used to
!	define user-commands
! INPUTS
!	J	- ?
!	T	- ?
!-
    BEGIN
    IF .DEFOPTAB[.J+.T] EQL 0 THEN RETURN;
    OUTS('Define ');
    IF (.DEFOPTAB[.J] AND %O'777600777777') EQL 0 
    THEN
	BEGIN
	OUTC(%C'"');
	OUTC(.(DEFOPTAB[.J])<LH>);
	OUTC(%C'"')
	END
    ELSE
	BEGIN
	PRSYM6(.DEFOPTAB[.J]);
	END;
    OUTC(%C',');
    IF  .DEFOPTAB[.J+.T] NEQ 0
    THEN
	CASE .T FROM 0 TO 4 OF
	    SET
	    [1]:		OUTS('null=');
	    [2]:		OUTS('prefix=');
	    [3]:		OUTS('postfix=');
	    [4]:		OUTS('infix=');
	    [INRANGE,OUTRANGE]:	0
	    TES;

    OUTFD(.(DEFOPTAB[.J+.T])<LH>,0);
    OUTC(%C',');
    PRQUAL(.(DEFOPTAB[.J+.T])<RH>,1);
    CRLF
    END;				! End of OUTOP
ROUTINE XSTORE:NOVALUE=
!+
! FUNCTION
!       Produce a "re-executable" command sequence to attain present
!       "state".
!-
    BEGIN
    MAP
	GQUALIFIER	: SYMBOL;
%IF TOPS10
%THEN
    LOCAL
	SAVEFF;

    SAVEFF = .$JBFF;
%FI

    IF NOT FILEOPEN(0,ASCIIMODE) THEN RETURN;
    SETOFF(ERRORFLAG);
    SETON(DISKOFLAG);
    IF ISON(COPQFLAG) THEN OUTS('COPAQUE',%CHAR(CR,LF));
    IF ISON(NOPOLLFLAG) THEN OUTS('POLLOFF',%CHAR(CR,LF));
    IF ISON(TRACEFLAG) THEN OUTS('SETTRACE',%CHAR(CR,LF));
    IF .$JB41 EQL DBG_OFF_INST THEN OUTS('NODEBUG',%CHAR(CR,LF));
    IF .IOBASE NEQ 8 
    THEN
	BEGIN
	OUTS('Base 0',%CHAR(CR,LF),'Base ');	OUTN(.IOBASE,8,1); CRLF
	END;

    IF .WDBASE NEQ IWDBASE
    THEN
	BEGIN
	OUTS('WBase ');	OUTDEFAULT(.WDBASE);	CRLF
	END;

    IF .GQUALIFIER NEQ 0 
    THEN
	BEGIN
	! validate cache
	ISHIGHSYMBOLTABLE();
	IF .HQUALIFIER EQL .$JBSYM OR .HQUALIFIER EQL .HCACHE
	THEN
	    BEGIN
	    OUTS('Qualify ');	PRSYM50(.GQUALIFIER[RAD50NAME]); CRLF
	    END
	END;

    ! Save all the actions
    !
    DECR J FROM .NROUTS TO 0 DO
	BEGIN
	LOCAL
	    T	: BLOCK[1];	! action bits

	T = .ROUTS[.J,0,FW] AND (BREAKV + ABREAKV + OPQATV + OPQAFTV + TRCATV + TRCAFTV);		! actions to save

	DECR IDX FROM MAXACTRTN TO 18 DO
	    BEGIN
	    LOCAL
		TPTR,
		TCHAR;


	    IF .T[INTEREST(.IDX)]			! Interesting EVENT?
	    THEN
		BEGIN
		IF .ROUTS[.J, CNDACTION(.IDX)] NEQ 0	! Look for conditional
		THEN					!  events and dump
		    BEGIN				!  the conditional
		    OUTS('If |');			!  text.
		    TPTR = CH$PTR(.ROUTS[.J, CNDACTION(.IDX)]);
		    WHILE (TCHAR = CH$RCHAR_A(TPTR)) NEQ %O'177' DO
			OUTC(.TCHAR);
		    OUTS('| ')
		    END;

		PRSYM50(ACTBIT2NAM(1^.IDX));	! now output the action name
		OUTC(%C' ');
		PRQUAL(.ROUTS[.J,0,RH,0],1);	! And Routine name too
		CRLF
		END
	    END
	END;
    ! Save the macros

    DECR J FROM .NNAMES TO 0 DO
	BEGIN
	LOCAL
	    PTR;
	REGISTER
	    C;

	PTR = CH$PTR(.SIXNAMES[.J,MACRO_BODY]);	! Convert 18-bits to byte-ptr
	OUTS('Macro ');
	PRSYM50(.SIXNAMES[.J,MACRO_NAME]);
	OUTS(' = |');
	WHILE (C=CH$RCHAR_A(PTR)) NEQ %O'177' DO OUTC(.C);
	OUTS('|',%CHAR(CR,LF))
	END;

    ! Save the BINDs
    BEGIN
    LOCAL
	JSYM;

    JSYM = .$JBSYM;
    $JBSYM = .IJOBSYM;		! don't use new symbols for printout!

    INCR SYM FROM .JSYM<RH> TO (.IJOBSYM<RH>)-2 BY 2 DO
	BEGIN
	MAP
	    SYM : SYMBOL;

	OUTS('Bind ');
	PRQ50(.SYM[RAD50NAME]);
	OUTS(' = ');
	PRQUALBP(.SYM[VALUEWRD],1);
	CRLF
	END;
    $JBSYM = .JSYM
    END;

    ! Save the user-defined operators

    DECR J FROM .NEWOPS TO 0 BY OPSIZE DO
	BEGIN

	DECR T FROM 4 TO 1 DO OUTOP(.J,.T)
	END;

	
    ! Save the MONITOR locations

    DECR I FROM .NVALS TO 0 DO
	BEGIN
	IF .MONVALS[.I,WATCHTAG]
	THEN
	    OUTS('Watch ')
	ELSE
	    OUTS('Monitor ');
	PRQUALBP(.MONVALS[.I,WATCHED_LOCATION]);
	CRLF;
	END;

    ! Now close the file
    SETOFF(DISKOFLAG);

%IF TOPS10
%THEN
    IF ISON(ERRORFLAG)
    THEN
	BEGIN
	ERROR(11);
	CLOSE(SLCHN,CL$RST);
	END
    ELSE
	CLOSE(SLCHN,0);
    RELEASE(SLCHN,0);
    $JBFF = .SAVEFF;
%ELSE
    CLOSF( .DSKHDR );
%FI
    END;
ROUTINE XRECALL : NOVALUE=
!+
! FUNCTION
!	RECALL command - complement of STORE.  Reads commands from a
!		file.
!
!-
    BEGIN
    LOCAL
	SAVEFF,
	SAVEGO;

%IF TOPS10
%THEN
    SAVEFF = .$JBFF;
%FI

    IF NOT FILEOPEN(1,ASCIIMODE) THEN RETURN;

    SETOFF(ERRORFLAG);
    SETON(DISKIFLAG);
    SAVEGO = .GOFLAG;
    GOFLAG = 0;
    ISUB();
    SETOFF(DISKIFLAG);
    GOFLAG = .SAVEGO;

    IF ISON(ERRORFLAG) THEN ERROR(11);

%IF TOPS10
%THEN
    CLOSE(SLCHN,0);
    RELEASE(SLCHN,0);
    $JBFF = .SAVEFF
%ELSE
    CLOSF( .DSKHDR )
%FI
END;
%SBTTL 'Further Command Routines'

ROUTINE BOOBOO : NOVALUE =ERROR(4);

ROUTINE COPYR : NOVALUE=(SIXVP = .SIXRP;  SIXVC = .SIXRC);

ROUTINE XDEFINE : NOVALUE=(QUOTFLG = 2;  MODEFLAG = 1);

ROUTINE XSET1 : NOVALUE=(QUOTFLG = 1;  MODEFLAG = 1);

ROUTINE XSET2 : NOVALUE=(QUOTFLG = 1;  MODEFLAG = 2);

ROUTINE XSET3 : NOVALUE=(QUOTFLG = 1;  MODEFLAG = 3);

ROUTINE SETAFTER : NOVALUE=(MODEFLAG = 1 );

ROUTINE SETFROM : NOVALUE=(MODEFLAG = 2 );
ROUTINE XIDENT : NOVALUE=
!+
! FUNCTION
!	Identify linkage conventions in use.
!-
    BEGIN
    ROUTINE REGLIST(CVP: REF VECTOR) :NOVALUE=
	!+
	! FUNCTION
	!	Utility to output a list of register names
	!-
	DECR I FROM .CVP[-1]-1 TO 0 DO
	    BEGIN
	    OUTD(.CVP[.I]);
	    IF .I NEQ 0 THEN OUTC(%C',')
	    END;

    SIXID();
    OUTS('Using default linkage with registers (decimal):');  CRLF;
    OUTS('   Stack pointer: ');  OUTD(SREG);  CRLF;
    OUTS('   Frame pointer: ');  OUTD(FREG);  CRLF;
    OUTS('   Value register: '); OUTD(VREG);  CRLF;
    OUTS('   Preserved registers: '); REGLIST( PLIT(PRREGS) ); CRLF;
    OUTS('   Non-preserved registers: '); REGLIST( PLIT(NPREGS) ); CRLF
    END;
!	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 SIXBIT 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 the SIX12 manual.

! These macros simplify entering operators...

MACRO
    ACHAR(OP,P0,R0,P1,R1,P2,R2,P3,R3)=
	OP^18,
	(P0)^18+ R0,
	(P1)^18+ R1,
	(P2)^18+ R2,
	(P3)^18+ R3 %;

MACRO
    ANAME(OP,P0,R0,P1,R1,P2,R2,P3,R3)=
	%SIXBIT %STRING(OP),
	(P0)^18+ R0,
	(P1)^18+ R1,
	(P2)^18+ R2,
	(P3)^18+ R3 %;


BIND
    OPTAB=  PLIT(

!     Name	NULL		PREFIX		POSTFIX		INFIX
ANAME(ACTION,	50,XSET2,	0,0,		0,0,		0,0),
ANAME(AFTER,	50,SETAFTER,	0,0,		0,0,		0,0),
ANAME(FROM,	50,SETFROM,	0,0,		0,0,		0,0),
ANAME(OPER,	50,XSET1,	0,0,		0,0,		0,0),
ACHAR(ESCAPE,	50,GETTEXT,	0,0,		0,0,		0,0),
ACHAR(BAR,	50,GETTEXT,	0,0,		0,0,		0,0),
!
!		^  ^  ^
!		|  |  |
!	Operators back here do not print out when HELP is done
ANAME(HELP,	50,XHELP,	0,0,		0,0,		0,0),
!		
!	All these commands will be printed by the HELP command
!		| | |
!		V V V
ANAME(ABREAK,	0,0,		10,XABREAK,	0,0,		10,XABREAK),
ANAME(AND,	0,0,		0,0,		0,0,		32,XAND),
ANAME(BACKTO,	0,0,		20,XBACKTO,	0,0,		0,0),
ANAME(BASE,	20,XBASE,	20,XBASE,	0,0,		0,0),
ANAME(BIND,	50,XSET2,	0,0,		0,0,		0,0),
ANAME(BREAK,	0,0,		10,XBREAK,	0,0,		10,XBREAK),
ANAME(CALL,	20,XCALL,	20,XCALL,	0,0,		0,0),
ANAME(CALLS,	50,CALL1,	0,0,		0,0,		0,0),
ANAME(CLRTRA,	50,XCLRTRACE,	0,0,		0,0,		0,0),
ANAME(COPAQU,	50,XCOPAQUE,	0,0,		0,0,		0,0),
ANAME(DABREA,	0,0,		10,DABREAK,	0,0,		0,0),
ANAME(DBREAK,	0,0,		10,DBREAK,	0,0,		0,0),
ANAME(DDT,	50,XDDT,	0,0,		0,0,		0,0),
ANAME(DEBUG,	50,XDEBUG,	0,0,		0,0,		0,0),
ANAME(DEFINE,	50,XDEFINE,	0,0,		0,0,		0,0),
ANAME(DISABL,	50,DISAB,	0,0,		0,0,		0,0),
ANAME(DMONIT,	0,0,		10,XDMONITOR,	0,0,		0,0),
ANAME(DOPAQU,	0,0,		10,DOPAQUE,	0,0,		0,0),
ANAME(DTRACE,	0,0,		10,DTRACE,	0,0,		0,0),
ANAME(DWATCH,	0,0,		10,XDMONITOR,	0,0,		0,0),
ANAME(EQL,	0,0,		0,0,		0,0,		36,XEQL),
ANAME(FORGET,	50,XDEL1,	0,0,		0,0,		0,0),
ANAME(GEQ,	0,0,		0,0,		0,0,		36,XGEQ),
ANAME(GO,	50,XGO,		0,0,		0,0,		0,0),
ANAME(GOCLR,	50,XGOCLR,	0,0,		0,0,		0,0),
ANAME(GOTRAC,	50,XGOTRACE,	0,0,		0,0,		0,0),
ANAME(GTR,	0,0,		0,0,		0,0,		36,XGTR),
ANAME(IDENT,	50,XIDENT,	0,0,		0,0,		0,0),
ANAME(IF,	50,DOTVREG,	0,0,		0,0,		0,0),
ANAME(LCALL,	20,XLCALL,	20,XLCALL,	0,0,		0,0),
ANAME(LCALLS,	50,CALL2,	0,0,		0,0,		0,0),
ANAME(LOAD,	0,0,		20,XLOAD,	0,0,		0,0),
ANAME(LPTCLO,	50,CLOSELPT,	0,0,		0,0,		0,0),
ANAME(LPTDUP,	50,LPTDUP,	0,0,		0,0,		0,0),
ANAME(LPTOFF,	50,LPTOFF,	0,0,		0,0,		0,0),
ANAME(LPTON,	50,LPTON,	0,0,		0,0,		0,0),
ANAME(LPTOPE,	50,OPENLPT,	0,0,		0,0,		0,0),
ANAME(LEQ,	0,0,		0,0,		0,0,		36,XLEQ),
ANAME(LSS,	0,0,		0,0,		0,0,		36,XLSS),
ANAME(MACRO,	50,XSET3,	0,0,		0,0,		0,0),
ANAME(MONITO,	10,XMONITOR,	10,XMONITOR,	0,0,		0,0),
ANAME(NEQ,	0,0,		0,0,		0,0,		36,XNEQ),
ANAME(NOCOPA,   50,XNOCOPAQUE,	0,0,		0,0,		0,0),
ANAME(NODEBU,	50,NOSIX12,	0,0,		0,0,		0,0),
ANAME(NOT,	0,0,		34,XNOT,	0,0,		0,0),
ANAME(OK,	50,XOK,		0,0,		0,0,		0,0),
ANAME(OPAQUE,	0,0,		10,OPAQUE,	0,0,		10,OPAQUE),
ANAME(OR,	0,0,		0,0,		0,0,		30,XEQOR),
ANAME(POLLOF,	50,XNOPOLLON,	0,0,		0,0,		0,0),
ANAME(POLLON,	50,XNOPOLLOFF,	0,0,		0,0,		0,0),
ANAME('POP',	20,XPOP,	20,XPOP,	0,0,		0,0),
ANAME(PRINT,	10,XPRINT,	10,XPRINT,	0,0,		0,0),
ANAME(PRM,	50,XPRM,	0,0,		0,0,		0,0),
ANAME(PRS,	50,XPRS,	0,0,		0,0,		0,0),
ANAME(QUALIF,	50,XQUAL,	0,0,		0,0,		0,0),
ANAME(RECALL,	0,0,		20,XRECALL,	0,0,		0,0),
ANAME(RESIGN,	20,XRESIGNAL,	20,XRESIGNAL,	0,0,		0,0),
ANAME(RESET,	50,XRESET,	0,0,		0,0,		0,0),
ANAME(RESUME,	20,XRESUME,	20,XRESUME,	0,0,		0,0),
ANAME(RETURN,	0,0,		20,XRETURN,	0,0,		0,0),
ANAME(SAVE,	0,0,		20,XSAVE,	0,0,		0,0),
ANAME(SEARCH,	0,0,		20,XSEARCH,	0,0,		0,0),
ANAME(SETTRA,	50,XSTRACE,	0,0,		0,0,		0,0),
ANAME(SIGNAL,	0,0,		20,XSIGNAL,	0,0,		0,0),
ANAME(STEP,	50,XSTEP,	0,0,		0,0,		0,0),
ANAME(STORE,	0,0,		20,XSTORE,	0,0,		0,0),
ANAME(TRACE,	0,0,		10,XTRACE,	0,0,		10,XTRACE),
ANAME(UNWIND,	50,XSETUNWIND,	0,0,		0,0,		0,0),
ANAME(WATCH,	10,XWATCH,	10,XWATCH,	0,0,		0,0),
ANAME(WBASE,	20,XWBASE,	20,XWBASE,	0,0,		0,0),
ANAME(WHERE,	0,0,		10,XWHERE,	0,0,		0,0),
ACHAR(LBRACE,	0,0,		0,0,		45,LGFLD,	0,0),  !LG change  {
ACHAR(RBRACE,	0,0,		0,0,		4,BOOBOO,	0,0),
ACHAR(LPOINTY,	0,0,		10003,COPYR,	0,0,		10003,FIELDSPEC),
ACHAR(RPOINTY,	0,0,		0,0,		3,BOOBOO,	0,0),
ACHAR(LSQUARE,	0,0,		10002,COPYR,	0,0,		10002,STRUCT),
ACHAR(RSQUARE,	0,0,		0,0,		2,BOOBOO,	0,0),
ACHAR(LEFTPAREN,0,0,		10001,COPYR,	0,0,		10001,LPAREN),
ACHAR(RPAREN,	0,0,		0,0,		1,BOOBOO,	0,0),
ACHAR(%C'=',	0,0,		0,0,		0,0,		9,EQUALS),
ACHAR(%C';',	5,DOTVREG, 	5,COPYR, 	5,DOTVREG, 	5,COPYR),
ACHAR(%C'^',	0,0,		0,0,		0,0,		42,XSHIFT),
ACHAR(%C'*',	0,0,		0,0,		0,0,		40,XTIMES),
ACHAR(%C':',	0,0,		0,0,		46,COLON,	0,0),  !LG change
ACHAR(%C'@',	20,XFUTURE,	20,XFUTURE,	0,0,		0,0),
ACHAR(%C'.',	0,0,		44,CONTENTS,	0,0,		0,0),
ACHAR(%C'-',	0,0,		38,XSUBTRACT,	0,0,		38,XSUBTRACT),
ACHAR(%C'+',	0,0,		38,COPYR,	0,0,		38,XADD),
ACHAR(%C',',	0,0,		0,0,		0,0,		15,JOIN),
ACHAR(%C'!',	0,0,		0,0,		0,0,		20,SLASH),
ACHAR(%C'/',	0,0,		0,0,		20,SLASH,	40,XDIV),
	0 )	:VECTOR;
LITERAL
    BRACEVAL = 10000,			! Special indicator for (,{,<,[..

    P_NULL=	21,			! Bit number for valid parses
    P_PREFIX=	20,
    P_POSTFIX=	19,
    P_INFIX=	18;
ROUTINE XPRS:NOVALUE=
!+
! FUNCTION
!	COMMAND: PRS name ,...
!-
    BEGIN
    QUOTFLG = BIGNUMBER;

    PUSHOPER( %(permissible parse: Prefix )% MASK_(P_PREFIX) +
	 UPLIT(ANAME(XPRS, %(null)% 0,0, %(prefix)% 10,PRS, %(postfix)% 0,0, %(infix)% 0,0)) + 1);
    END;
ROUTINE XPRM : NOVALUE=
    !
    ! COMMAND: PRM name ,...
    !
    BEGIN
    QUOTFLG = BIGNUMBER;
    PUSHOPER(%(permissible parse: null, prefix )% MASK_(P_NULL,P_PREFIX) +
	 UPLIT(ANAME(XPRM, %(null)% 10,PRM, %(prefix)% 10,PRM, %(postfix)% 0,0, %(infix)% 0,0)) + 1)
    END;
ROUTINE EQUALS0= ERROR(7);
GLOBAL ROUTINE SIXOP(NEWOP,PARSE,PRIORITY,RTN)=
!+
! FUNCTION
!	Add a new operator to SIX12
!-
    BEGIN
    LOCAL
	ENTRY,
	OLD;

    !+
    ! Look-up in operator table
    !-
    ENTRY = (DECR J FROM .NEWOPS TO 0 BY OPSIZE DO
		IF .NEWOP EQL .DEFOPTAB[.J] THEN EXITLOOP .J );

    IF .ENTRY LSS 0				! Not found, so
    THEN					!  insert new entry
	BEGIN
	ENTRY = NEWOPS = .NEWOPS+OPSIZE;
	DEFOPTAB[.NEWOPS] = .NEWOP;
	OLD = ( DECR J FROM .OPTAB[-1]-(OPSIZE+1) TO 0 BY OPSIZE DO
		IF .NEWOP 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)
	END;
    (DEFOPTAB[.ENTRY+1+.PARSE])<LH> = .PRIORITY;
    (DEFOPTAB[.ENTRY+1+.PARSE])<RH> = .RTN;
    1
    END;
ROUTINE X2DEFINE: NOVALUE=
!+
! FUNCTION
!	Second-level Define action routine (triggered by XDefine)
!-
    BEGIN
    LOCAL
	OLD,
	PARSE,
	ENTRY,				! DEFINE (OPERATOR)
	NEWOP;

    IF .SIXRC NEQ 2 OR .SIXLC NEQ 2 THEN RETURN ERROR(3);

    PARSE = .SIXLP[1];

    !+
    ! "Parse" may be a numeric code or a special string
    !-

    IF .PARSE LSS 0 OR .PARSE GTR 3
    THEN
	PARSE =
	    BEGIN
	    SELECT .PARSE OF
		SET
	       [%RAD50_10 'NULL']:	0;
	       [%RAD50_10 'PREFIX']:	1;
	       [%RAD50_10 'POSTFI']:	2;
	       [%RAD50_10 'INFIX']:	3;
	       [OTHERWISE]:		(ERROR(31);  RETURN )
		TES
	    END;

    NEWOP = ( IF .(.SIXLP)<RH> EQL 0 THEN ..SIXLP ELSE F50TO6(..SIXLP) );

    SIXOP(.NEWOP,.PARSE,.SIXRP[0], .SIXRP[1])
    END;
ROUTINE XBIND: NOVALUE=
!+
! FUNCTION
!	Implement the BIND command
!-
    BEGIN
    LOCAL
	S	: SYMBOL,
	T	: SYMBOL,
	R	: SYMBOL;	! Bind (CREATE DDT-SYMBOL)
    
    ! This uses only the lowseg symbol table for the BINDs
    
    R = .$JBSYM - %O'2000002';
    
    IF (S = NSDDTFA(%RAD50_10 'PAT..', 0)) EQL 0	! There isn't any
    THEN						!  patch area!
	RETURN ERROR(15);
    
    ! see if we are rebinding the symbol
    
    T=.$JBSYM;

    WHILE .T<RH> LSS .S<RH> DO
	BEGIN				%(scan bound symbols)%
	IF .T[RAD50NAME] EQL ..SIXLP
	THEN
	    IF .T[VALUEWRD] NEQ ..SIXRP
	    THEN
		BEGIN %(redefined)%
		OUTS('Redefined ');
		PRSYM50(..SIXLP);
		OUTS(', old value was ');
		OUTDEFAULT(.T[VALUEWRD]);
		DBLEQL();
		PRDISP(.T[VALUEWRD]);
		T[VALUEWRD] = .SIXRP[0];
		CRLF;
		RETURN
		END %(redefined)%
	    ELSE
		RETURN;

	T= .T+%O'2000002'
	END;

    ! if we get here, the symbol is being bound for the first time
    !

    IF .R<RH> LSS .S[SYMBOLVAL] THEN RETURN ERROR(15);

    R[NAMEWRD] = ..SIXLP OR DDT$_GLOBAL^32;	! DEFINE AS Global SYMBOL
    R[VALUEWRD] = .SIXRP[0];

    $JBSYM = .R;

    ! Now update the size field of PAT.. module patch area, by adjusting the
    ! module symbol count appropriately.
    !

    S[SYMBOLCNT] = .S[SYMBOLCNT] - 2
    END;
ROUTINE XMACRO : NOVALUE=
!+
! FUNCTION
!	Establish a MACRO definition
 !-
    BEGIN
    IF .NNAMES GEQ NMACROS THEN RETURN ERROR(13);

    DECR J FROM .NNAMES TO 0 DO
	IF ..SIXLP EQL .SIXNAMES[.J,MACRO_NAME] THEN RETURN ERROR(14);

    SIXNAMES[(NNAMES = .NNAMES+1),MACRO_NAME] = ..SIXLP;
    SIXNAMES[.NNAMES,MACRO_BODY] = ..SIXRP
    END;
ROUTINE XASSIGN : NOVALUE=
!+
! FUNCTION
!	Implements the "=" operator
! NOTES
!	Constant position and size are handled in destination expressions
!-
    BEGIN
    MAP
	SIXLP	: REF $BYTE_POINTER;

    IF .SIXLP[P_POS_SIZE] EQL 0
    THEN       					!ADD P,S =<FW>
	SIXLP[P_SIZE] = 36;

    IF .SIXLP[P_POS] + .SIXLP[P_SIZE] GTR %BPVAL OR
	.SIXLP[P_INDEX] NEQ 0
    THEN
	(PRBPTR(.SIXLP[0,FW]);  RETURN ERROR(18));

    IF NOT ISADDRESS(..SIXLP)
    THEN
	BEGIN
	ILLMEM = .SIXLP[0,FW];
	ERROR(28);
	RETURN
	END;
    IF NOT ISWRITABLE(.SIXLP[0,FW])
    THEN
	BEGIN
	ILLMEM = .SIXLP[0,FW];
	ERROR(32);
	RETURN;
	END;

    REPLACEN( SIXLP[0,FW], .SIXRP[0] );

    IF .NVALS GEQ 0 THEN CKVALS(0,-2);	! CHECK MONITORED LOCATIONS
    END;
BIND
    EQUALSDISP = UPLIT(EQUALS0,X2DEFINE,XBIND,XMACRO,XASSIGN) : VECTOR;

ROUTINE EQUALS :NOVALUE=
!+
! FUNCTION
!	Dispatch to specific ROUTINE
!-
    (.EQUALSDISP[.MODEFLAG])();
!
!   COMMAND: PRINT
!


BIND
    XPRINTDISP = UPLIT(XPRINT0,XPRINTOPER,XPRINTACT,XPRINTMACRO,XPRINTMON)	:VECTOR;

ROUTINE XPRINT = (.XPRINTDISP[.MODEFLAG])();	!DISPATCH to SPECIFIC ROUTINES

ROUTINE XPRINT0 = ERROR(2);
ROUTINE XPRINTOPER:NOVALUE =
!
! COMMAND: PRINT OPER
!
    BEGIN
    LOCAL
	WHICHOP,
	PNTR	: REF VECTOR;			! OPERATOR

    ! If the operator is in radix50, then some bits outside the left
    ! halfword character code will be set, so we use this test to 
    ! determine which kind we have

    WHICHOP = ( IF (..SIXRP AND %O'777600777777') NEQ 0
		THEN
		    F50TO6(.SIXRP[0])
		ELSE
		    .SIXRP[0] );

    IF .SIXRC GTR 1 THEN RETURN ERROR(3);

    PNTR = ( DECR J FROM .NEWOPS TO 0 BY OPSIZE DO
		IF .WHICHOP EQL .DEFOPTAB[.J]
		THEN
		    EXITLOOP (DEFOPTAB[.J]) );

    IF .PNTR LSS 0
    THEN
	PNTR = ( DECR J FROM .OPTAB[-1]-(OPSIZE+1) TO 0 BY OPSIZE DO
			IF .WHICHOP EQL .OPTAB[.J]
			THEN
			    EXITLOOP OPTAB[.J] );

    IF .PNTR LSS 0
    THEN
	(OUTS('No such operator',%CHAR(CR,LF) );  RETURN);

    PROP(.PNTR[0]);
    IF .PNTR[1] NEQ 0
    THEN
	BEGIN
	OUTS( %CHAR(CR,LF),'Null',%CHAR(9) );
	OUTFD(.(PNTR[1])<LH>,5);
	PUTTAB;
	PRXDISP(.PNTR[1])
	END;
    IF .PNTR[2] NEQ 0
    THEN
	BEGIN
	OUTS( %CHAR(CR,LF),'Prefix',%CHAR(9) );
	OUTFD(.(PNTR[2])<LH>,5);
	PUTTAB;
	PRXDISP(.PNTR[2])
	END;
    IF .PNTR[3] NEQ 0
    THEN
	BEGIN
	OUTS( %CHAR(CR,LF),'Postfix',%CHAR(9) );
	OUTFD(.(PNTR[3])<LH>,5);
	PUTTAB;
	PRXDISP(.PNTR[3])
	END;
    IF .PNTR[4] NEQ 0
    THEN
	BEGIN
	OUTS( %CHAR(CR,LF),'Infix',%CHAR(9) );
	OUTFD(.(PNTR[4])<LH>,5);
	PUTTAB;
	PRXDISP(.PNTR[4])
	END;
    CRLF
    END;
! The following definitions are used by
! the "PRINT ACTION" display routines

MACRO
    ATM(A,B) = %RAD50_10 A,B %;

BIND
    ALLACTV =					! ALL ACTION BITS
	    BREAKV+ABREAKV+OPQATV+OPQAFTV+TRCATV+TRCAFTV+TABREAKV,
    ACTTBL =
	    PLIT (
		ATM('BREAK',	BREAKV ),
		ATM('ABREAK',	ABREAKV),
		ATM('OPAQ',	OPQATV),
		ATM('OPAQAF',	OPQAFTV),
		ATM('TRACE',	TRCATV),
		ATM('TRACEA',	TRCAFTV),
		ATM('OK',	TABREAKV),
		ATM('ALL',	ALLACTV)
		)
		 :	VECTOR;		! <= "ALL" must be the last entry
ROUTINE ACTBIT2NAM(BIT_VAL) =
!+
! FUNCTION
!	Convert a bit-mask value (action mask) into its print-name
!-
    (DECR J FROM .ACTTBL[-1]/2-2 TO 0 DO
	IF .ACTTBL[.J*2+1] EQL .BIT_VAL
	THEN EXITLOOP .ACTTBL[.J*2]);
ROUTINE ACTNAM2BIT(NAM) =
!+
! FUNCTION
!	Convert print name to bit mask
! INPUT
!	NAM	- Name in ???? (sixbit?)
! OUTPUT
!	Bitmask for setting into table or ZERO if name not found
!-
    BEGIN
    DECR J FROM .ACTTBL[-1]/2-1 TO 0 DO
	IF .ACTTBL[.J*2] EQL .NAM
	THEN
	    RETURN .ACTTBL[.J*2+1];

    0
    END;
ROUTINE PR1ACTION(NAME,TYPE):NOVALUE =
!+
! FUNCTION
!	Print one action.
! INPUTS
!	NAME	- Routine address
!	TYPE	- Mask of action type
!-
    BEGIN
    LOCAL
	P,			! Index into ROUTS of a routine
	T;
    LABEL
	NEXTACT;

    IF (P = CFINDR(.NAME)) LSS 0
    THEN
	(OUTS('No actions set',%CHAR(CR,LF));  RETURN);

    T = .ROUTS[.P,0,FW] AND .TYPE;	! Masked by Events we're interested in

    IF .T NEQ 0 AND .SIXRC EQL 1
    THEN
	BEGIN
	OUTS('Routine ');  PRQUAL(.ROUTS[.P,0,RH,0],1);  CRLF
	END;

    DECR I FROM MAXACTRTN TO 18 DO
NEXTACT:
	BEGIN
	MAP
	    T:	BITVECTOR;

	IF NOT .T[.I] THEN LEAVE NEXTACT;	! Ignore uninteresting events

	IF .TYPE EQL ALLACTV		! When ALL actions are desired,
	THEN				!  print the action-name we are
	    BEGIN			!  going to display next.
	    PRSYM50(ACTBIT2NAM(1^.I));
	    OUTS(':',%CHAR(9) )
	    END;

	IF .ROUTS[.P, CNDACTION(.I)] EQLA 0
	THEN
	    (OUTS('Unconditional'); CRLF)
	ELSE
	    BEGIN
	    LOCAL
		TV,		! Pointer to conditional text
		TC;		! Next character

	    TV = CH$PTR( .ROUTS[.P, CNDACTION(.I)] );
	    WHILE (TC = CH$RCHAR_A(TV)) NEQ %O'177' DO OUTC(.TC);
	    CRLF
	    END
	END
    END;
ROUTINE XPRINTACT :NOVALUE=
!+
! FUNCTION
!	Implements the		PRINT ACTION <type> <name>
!	command
! IMPLICIT INPUTS
!	SIXRP[0]	- action-type
!	SIXRP[1]	- optional routine name
!-
    BEGIN
    LOCAL
	TMP;

    IF .SIXRC LSS 1 OR .SIXRC GTR 2 THEN RETURN ERROR(3);	! Check args

    IF (TMP = ACTNAM2BIT(..SIXRP)) EQL 0 THEN RETURN ERROR(8);	! Bad type

    IF .SIXRC EQL 2
    THEN
	PR1ACTION(.SIXRP[1], .TMP)	! Display given name
    ELSE
	! Display all names for this action
	BEGIN
	IF .NROUTS EQL -1
	THEN
	    (OUTS('No actions set',%CHAR(CR,LF));  RETURN);

	DECR J FROM .NROUTS TO 0 DO PR1ACTION(.ROUTS[.J,0,FW],.TMP)
	END
    END;
ROUTINE PR1MACRO(NAME) :NOVALUE=
    ! Print one Macro definition
    BEGIN
    LOCAL
	PNTR,
	C;
    PNTR = ( DECR J FROM .NNAMES TO 0 DO
		IF .NAME EQL .SIXNAMES[.J,0,FW] THEN EXITLOOP .J );
    IF .PNTR LSS 0
    THEN
	(OUTS( 'No such macro',%CHAR(CR,LF) );  RETURN);

    PNTR = CH$PTR(.SIXNAMES[.PNTR,1,FW]);

    WHILE (C =CH$RCHAR_A(PNTR)) NEQ %O'177' DO OUTC(.C);

    CRLF
    END;
ROUTINE XPRINTMACRO:NOVALUE =
!
! COMMAND: PRINT Macro [NAME]
!
    BEGIN
    IF .SIXRC GTR 1 THEN RETURN ERROR(3);
    IF .SIXRC EQL 1
    THEN
	! PRINT GIVEN Macro
	PR1MACRO(..SIXRP)
    ELSE
	! PRINT ALL MACROS
	BEGIN
	LOCAL
	    P;
	IF .NNAMES EQL -1
	THEN (OUTS( 'No macros defined',%CHAR(CR,LF) );  RETURN);

	DECR J FROM .NNAMES TO 0 DO
	    BEGIN
	    P = .SIXNAMES[.J,0,FW];
	    PRSYM50(.P);
	    OUTS(' =',%CHAR(9) );
	    PR1MACRO(.P)
	    END
	END;
    END;
    	%SBTTL	'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 <21,1>, prefix-<20,1>, postfix-<19,1>, infix-<18,1>) 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 CR) %;

MACRO 	PARSEFIELD=18,4,0 %,
	PARSENULL=21,1,0 %,
	PARSEPREFIX=20,1,0 %,
	PARSEPOSTFIX=19,1,0 %,
	PARSEINFIX=18,1,0 %;
ROUTINE ADVANCE:NOVALUE=		! GET NEXT CHARACTER
    BEGIN
    IF .NPCHAR EQL 0 THEN NCHAR = .NCHAR+1;
    CHAR = CH$RCHAR_A(PCHAR[.NPCHAR]);

    IF .CHAR EQL %O'177'	! End of input-stream indicator?
    THEN
	BEGIN
	NPCHAR = .NPCHAR-1;	! Back down to previous input-stream
	CHAR = %C' ';		! Force break in parse at end of Macro
	END;
    END;
LITERAL
    T_NUMBER	= 0,
    T_ALPHA	= 1,
    T_RADIX	= 2,
    T_QUOTE	= 3,
    T_OTHER	= 4;

ROUTINE TYPE(TFLAG)=
!+
! FUNCTION
!	Determine type of character in CHAR for input scanning.
! INPUTS
!	TFLAG	- Zero for normal name. 1, if name began with "?" to
!		  quote it.
! OUTPUTS
!	value indicating type of character, from set
!		0	- numeric
!		1	- alphabetic
!		2	- numeric over-ride "#"
!		3	- quoting characters " and '
!		4	- all other operator chars, etc.
!-
    BEGIN
    SELECTONE .CHAR OF
	SET
	[%C'0' TO %C'9']:	.TFLAG;		! ?<digit> is alpha, else num
	[%C'A' TO %C'Z']:	T_ALPHA;
	[%C'a' TO %C'z']:	T_ALPHA;
	[%C'&']:		T_ALPHA;
	[%C'_', %C'$']:		T_ALPHA;
	[%C'.', %C'%']:		IF .TFLAG	! MACRO-10 specials, if "?"
				THEN		!  seen to quote it
				    T_ALPHA	!  say it's alpha
				ELSE
				    T_OTHER;	! No, it's a special character
	[%C'#']:		T_RADIX;
	[DQUOTE]:		T_QUOTE;	! ASCII "
	[SQUOTE]:		T_QUOTE;	! ASCII '
	[OTHERWISE]:		T_OTHER
	TES
    END;
ROUTINE ERROR(EN)=
!+
! FUNCTION
!	Error message printouts
!-
    BEGIN
    IF .EN GEQ 0 THEN SETON(ERRORFLAG) ELSE EN = - .EN;

    IF ISON(DISKIFLAG)
    THEN
	BEGIN
	LOCAL
	    PTR,
	    C;
	PTR = CH$PTR(BUFF);
	OUTC(%C'&');
	WHILE (C=CH$RCHAR_A(PTR)) NEQ CR DO OUTC(.C);
	CRLF
	END;

    SELECTONE .EN OF
	SET
	[0 TO 4, 16,17,22,25,38]:
		(TTOUTM(%C'.',.NCHAR);  TTOUTC(%C'^');  TTCRLF);
	[28,32,33]:
		(PRBPTR(.ILLMEM))
	TES;

    CASE .EN FROM 0 TO 38 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 decimal');
	[6]:	TTOUTS(': No debug linkage found for this routine');
	[7]:	TTOUTS('Invalid equals');
	[8]:	TTOUTS('ACTION-type must be one of: BREAK, ABREAK, OPAQ, OPAQAF, TRACE, TRACEA or ALL');
	[9]:	TTOUTS('Improper file-spec');
	[10]:	TTOUTS('Open failure ');
	[11]:	TTOUTS('Transmission error');
	[12]:	TTOUTS('No space for macro text');
	[13]:	TTOUTS('No space for macro name definition');
	[14]:	TTOUTS('Name already defined');
	[15]:	TTOUTS('No space for symbol definition');
	[16]:	(TTOUTS('Digit invalid for base ');  OUTD(.IOBASE));
	[17]:	TTOUTS('Actual/Local index out of range');
	[18]:	TTOUTS(': Invalid field reference (byte pointer)');
	[19]:	TTOUTS('Line printer file not open');
	[20]:	TTOUTS('Line printer file still open');
	[21]:	TTOUTS('DDT not loaded');
	[22]:	(TTOUTS('Multiple definitions in DDT symbol table for ');  PRSYM50(.ERRORPARM));
	[23]:	TTOUTS('Impossible error 23');
	[24]:	TTOUTS('OK works only at routine entry');
	[25]:	TTOUTS('Ambiguous command name');
	[26]:	TTOUTS('Not available for Bliss-10');
	[27]:	TTOUTS('Valid only when in signal handler routine');
	[28]:	%IF TOPS10
		%THEN
		    TTOUTS(': Ill Mem Ref');
		%ELSE
		    TTOUTS(': Refers to non-existent page');
		%FI
	[29]:	TTOUTS('Already at top SIX12 level');
	[30]:	(TTOUTS('You are already above level '); OUTD(..SIXRP));
	[31]:	TTOUTS('Which Parse?');
	[32]:	TTOUTS(': Memory Write Protected');
	[33]:	%IF TOPS20 %THEN TTOUTS(': Memory Read Protected') %FI ;
	[34]:	TTOUTS('Warning: You are in NODEBUG mode');
	[35]:	TTOUTS('Operation makes no sense in NODEBUG mode');
	[36]:	TTOUTS('Module is in different high segment');
	[37]:	TTOUTS('Could not find SS$UNW in symbol table');
	[38]:	TTOUTS('Reserved for future use');
	[INRANGE,OUTRANGE]:	
		0
	TES;
%IF TOPS20
%THEN
	IF .EN EQL 10
	THEN
	    ERSTR( $PRIOU, $FHSLF^18+%O'777777', 0);	! Last JSYS error
%FI
    TTCRLF;
    0
    END;
ROUTINE PRSTK(K) : NOVALUE=
!+
! FUNCTION
!	Print the DEBUG parse stack
! INPUT
!	K	- depth to print to
!-
    BEGIN
    LOCAL
	I;

    IF .K EQL 0 THEN K = .TOPSTK;		! except 0 means all of it

    I = .TOPSTK;

    WHILE .I GTR .TOPSTK-.K DO
	BEGIN %(print it)%
	IF .DBGSTK[.I] LSS 0
	THEN
	    BEGIN %(operator)%
	    PROP(.(.(DBGSTK[.I-1])<0,18>-1));
	    OUTC(%C' ');
	    IF .(DBGSTK[.I-1])<PARSENULL> THEN PRSYM50(%RAD50_10 'NULL.');
	    IF .(DBGSTK[.I-1])<PARSEPREFIX> THEN PRSYM50(%RAD50_10 'PREFX.');
	    IF .(DBGSTK[.I-1])<PARSEPOSTFIX> THEN PRSYM50(%RAD50_10 'PSTFX.');
	    IF .(DBGSTK[.I-1])<PARSEINFIX> THEN PRSYM50(%RAD50_10 'INFIX.');
	    CRLF;
	    I = .I - 2;
	    END %(operator)%
	ELSE
	    BEGIN %(operand)%
	    OUTC(%C'['); OUTFD(.DBGSTK[.I],0); OUTC(%C']');
	    INCR J FROM .I-.DBGSTK[.I] TO .I-1 DO
		BEGIN
		OUTDEFAULT(.DBGSTK[.J]);
		OUTC(%C' ');
		END;
	    CRLF;
	    I = .I - (.DBGSTK[.I]+1);
	    END %(operand)%;
	END %(print it)%;
    END;
ROUTINE PUSHOPER(OPERATOR):NOVALUE=
!+
! FUNCTION
!	Push an operator onto the evaluation stack
    BEGIN
    TOPSTK = .TOPSTK+2;
    DBGSTK[.TOPSTK-1] = .OPERATOR;
    DBGSTK[.TOPSTK] =  1^35 OR .TOPOP<RH>;		! Sign is OPERATOR flag
    TOPOP = .TOPSTK;
    IF .PARSEDEBUG THEN (OUTS('op: '); PRSTK(2))	! print this operator
    END;
ROUTINE PUSHITEM(AWORD):NOVALUE=
!+
! FUNCTION
!	PUT 1-WORD OPERAND ON STACK
!-
    BEGIN
    IF .TOPSTK GEQ 0 AND .DBGSTK[.TOPSTK] GEQ 0 ! Already a partial operand
    THEN					!  on stack. Make room for
	BEGIN					!  one more component
	TOPSTK = .TOPSTK+1;
	DBGSTK[.TOPSTK] = .DBGSTK[.TOPSTK-1] + 1;
	DBGSTK[.TOPSTK-1] = .AWORD;
	IF .PARSEDEBUG THEN (OUTS('operand: '); PRSTK(2));	! print this operand
	RETURN
	END;
    TOPSTK = .TOPSTK+2;			 ! Make room for new operand
    DBGSTK[.TOPSTK] = 1;
    DBGSTK[.TOPSTK-1] = .AWORD;
    IF .PARSEDEBUG THEN (OUTS('operand: '); PRSTK(2));	! print this operand
    END;
ROUTINE GETNUMBER=
!+
! FUNCTION
!	Pick up number
! NOTES
!	It is necessary to acquire a register pair for doing the MUL
!	instruction.
!-
    BEGIN
    REGISTER				! Hope these are preserved regs.
	VAL = S1036(14,8),
	VAL2= S1036(15,9);

    VAL = 0;

    IF TYPE(FALSE) NEQ T_NUMBER THEN RETURN ERROR(2);

    DO
	BEGIN
	IF (.CHAR - %C'0') GEQ .IOBASE		! Check that digits are in
	THEN					!  the domain of the current
	    (NCHAR = .NCHAR+1;  ERROR(16));	!  input radix.

	MUL(VAL,IOBASE);  

	VAL2<35,1> = 0;				! Clear out for "predictability

	IF .VAL THEN VAL2<35,1> = 1;		! Keep sign in LSB's

	VAL = .VAL2 + .CHAR - %C'0';
	ADVANCE()
	END
    WHILE TYPE(FALSE) EQL T_NUMBER;

    .VAL
    END;
ROUTINE GETSYMBOL(TFLAG)=
!+
! FUNCTION
!	GET RADIX-50 REPRESENTATION of SYMBOL
!-
    BEGIN
    REGISTER
	Z,
	N;

    Z = 0;
    N = 6;

    WHILE 1 DO
	BEGIN
	IF (N = .N-1) GEQ 0
	THEN
	    Z = %O'50' * .Z + F7TO50(.CHAR) ;

	ADVANCE();
	IF TYPE(.TFLAG) GTR T_ALPHA THEN EXITLOOP
	END;
    .Z
    END;
ROUTINE XHELP:NOVALUE=
!+
! FUNCTION
!	Implements the HELP command
!-
    BEGIN
    LOCAL
	R,
	FLAG,
	COUNT;

    FLAG = 0;
    COUNT = 0;

    OUTS('Builtin operators:',%CHAR(CR,LF) );

    INCR I FROM 0 TO .OPTAB[-1]-(OPSIZE+1) BY OPSIZE DO
	BEGIN
	IF .OPTAB[.I] EQL %SIXBIT 'HELP' THEN FLAG=1;
	IF .FLAG
	THEN
	    BEGIN
	    PROP(.OPTAB[.I]);	
	    IF (COUNT = .COUNT+1) MOD 8 EQL 0 
	    THEN
		OUTCRLF()
	    ELSE
		PUTTAB
	    END
	END;

    IF .NEWOPS GEQ 0 
    THEN
	OUTS(%STRING(%CHAR(CR,LF),'User-defined operators:',%CHAR(CR,LF) ));

    COUNT=0;
    INCR I FROM 0 TO .NEWOPS BY OPSIZE DO
	BEGIN
	PROP(.DEFOPTAB[.I]);
	IF (COUNT = .COUNT+1) MOD 8 EQL 0
	THEN
	    OUTCRLF()
	ELSE
	    PUTTAB
	END;

    OUTCRLF()
    END;
ROUTINE GETOP(OPNAME)=
!+
! FUNCTION
!	(SECOND) STACK WORD FOR OPERATOR
!-
    BEGIN
    REGISTER
	R;

    R = ( DECR I FROM .NEWOPS TO 0 BY OPSIZE DO
		IF .OPNAME EQL .DEFOPTAB[.I] THEN EXITLOOP DEFOPTAB[.I] );

    IF .R LSS 0
    THEN
	R = ( DECR I FROM .OPTAB[-1]-(OPSIZE+1) TO 0 BY OPSIZE DO
		IF .OPNAME EQL .OPTAB[.I] THEN EXITLOOP OPTAB[.I] );

    IF .R LSS 0
    THEN
	-1
    ELSE
	OPRETURN(R)
    END;
ROUTINE GETNAMEOP(OPNAME) = 
!+
! FUNCTION
!	Given an operator name (in RAD50) return the encoded value
!	for the operator.
! INPUTS
!	OPNAME	- RAD50 value of a possible operator.
! OUTPUTS
!	-1	No matches (not an operator)
!	-2	Multiple matches (ambiguous)
!	n>0	Encoding for operator to be pushed on DBGSTK
!-
    BEGIN
    LOCAL
	R,
	OP,
	SIXNAME,
	MASK,
	CT,
	NAME50;

    MACRO CHECK(X) = 
	BEGIN
	IF (OP = .(X)) EQL .SIXNAME THEN
	    (CT = -2; R = (X); LEAVE SEARCHTAB);

	IF (.OP<LH> AND %O'770000') NEQ 0
	THEN
	    BEGIN
	    OP = .OP XOR .SIXNAME;
	    OP = .OP AND (NOT .MASK);
	    IF .OP EQL 0 THEN (CT = .CT+1; R = (X))
	    END
	END %;

    LABEL SEARCHTAB;

    NAME50 = .OPNAME;
    OP = 0;
    MASK = -1;

    !+
    ! Convert the name from RAD50 into SIXBIT, as the OPTAB stores them
    ! that way.  Further, it makes it straightforward to compare under a
    ! mask when forcing at least two characters to match.
    !-
    WHILE .NAME50 NEQ 0 DO
	BEGIN
	R = .NAME50 MOD %O'50';
	NAME50 = .NAME50/%O'50';
	OP = .OP+(F50TO7(.R)-%O'40');
	OP = ROT(.OP,-6);
	MASK = LSH(.MASK, -6)
	END;

    SIXNAME = .OP;
    MASK<24,12> = 0;	! FORCE AT LEAST TWO CHARACTER MATCH
    CT = -1;		! COUNT MATCHES

SEARCHTAB:
    BEGIN
    DECR I FROM .NEWOPS TO 0 BY OPSIZE DO CHECK(DEFOPTAB[.I]);
    DECR I FROM .OPTAB[-1]-(OPSIZE+1) TO 0 BY OPSIZE DO CHECK(OPTAB[.I]);
    END;	! of SEARCHTAB:

    SELECTONE .CT OF
	SET
	[-2]:	0;					! Exact match required
	[-1]:	RETURN -1;				! No match
	[0]:	IF NSDDTFA(.OPNAME,0) NEQ 0		! One match
		THEN
		    RETURN -1;
      [OTHERWISE]: RETURN -2				! Multiple matches
      TES;

    RETURN OPRETURN(R)
    END;
ROUTINE GETTEXT : NOVALUE=
!+
! FUNCTION
!	Get ASCII text from input stream and store into the macro-text
!	area.  Since only 18-bit addresses are saved, it is vital that
!	"new" text always begins on a FULLWORD boundary and is padded
!	as necessary to end on a fullword also.
!-
    BEGIN
    VTEMP = .PTEXT<RH> + 1;	! This is an ILDB pointer, so RH would be
				!  one less than actual address.
    DO
	BEGIN
	CH$WCHAR_A( .CHAR, PTEXT );		! Write characters out
	IF .PTEXT<RH> GEQ TEXTAREA[2*NMACROS]
	THEN
	    RETURN ERROR(12);			! No more text space left
	ADVANCE()				! Get next character
	END
    UNTIL ENDOFLINE OR .CHAR EQL ESCAPE OR .CHAR EQL BAR;

    CH$WCHAR_A( %O'177',PTEXT);		! Mark EOT
    ADVANCE();
    PTEXT = CH$PTR( .PTEXT<RH>+1 );	! Force ptr to next fullword
    SIXVP = VTEMP;			! Address of result and
    SIXVC = 1				!  its size
    END;
ROUTINE GETSTRING:NOVALUE=
!+
! FUNCTION
!	Input a text string, either left-justified (ala Bliss-10 syntax)
!       or right-justified (almost useless for anything bigger than one
!       character)
!-
    BEGIN
    LOCAL
	HOLD;

    IF .CHAR EQL SQUOTE
    THEN
	BEGIN
	HOLD = CH$PTR( DBGSTK[.TOPSTK]+1 );	! Bufferspace for a string

	IF .TOPSTK GEQ 0 AND .DBGSTK[.TOPSTK] GEQ 0	! Clean some things off
	THEN						!  the stack
	    BEGIN
	    TOPSTK = .TOPSTK - .DBGSTK[.TOPSTK];
	    HOLD = .HOLD - 1
	    END;

	WHILE 1 DO
	    BEGIN
	    ADVANCE();
	    IF ENDOFLINE THEN EXITLOOP;
	    IF .CHAR EQL SQUOTE			! Eat '' as a single ' value
	    THEN				!  was terminating "'" value
		(ADVANCE();  IF .CHAR NEQ SQUOTE THEN EXITLOOP);
	    CH$WCHAR_A( .CHAR, HOLD )		! copy into output buffer
	    END;

	CH$WCHAR_A(0, HOLD);			! Make it ASCIZ

	HOLD = (CH$DIFF(.HOLD, CH$PTR(DBGSTK))+4)/5;	! Words since base of
							!  the stack
	DBGSTK[.HOLD+1] = .HOLD - .TOPSTK;		! Set length of this
							!  operand
	TOPSTK = .HOLD+1				! Mark new TOS
	END
    ELSE
	!+
	! Should be suspicious of this, as it creates 7-bit ASCII which is
	!  RIGHT-JUSTIFIED.  This can't be very useful for anything but a
	!  single character operator, such as is used when defining new
	!  operators.
	!-
	BEGIN
	HOLD = 0;
	WHILE 1 DO
	    BEGIN
	    ADVANCE();
	    IF ENDOFLINE THEN EXITLOOP;
	    IF .CHAR EQL DQUOTE
	    THEN
		(ADVANCE();  IF .CHAR NEQ DQUOTE THEN EXITLOOP);
	    HOLD = .HOLD^7 + .CHAR
	    END;
	IF (QUOTFLG = .QUOTFLG-1) GEQ 0 THEN HOLD = .HOLD^18;	! Char operator
	PUSHITEM(.HOLD)
	END;

    IF .PARSEDEBUG THEN (OUTS('str: '); PRSTK(2))
    END;
ROUTINE EXECUTE: NOVALUE=
!+
! FUNCTION
!	Execute operator on top of SIX12 Parse stack
!-
    BEGIN
    LOCAL
        SAVEGO,				! These are used to save environment
        SAVESTEP,			!  if the operator we are executing
        SAVETRACE,			!  is implemented by USER code, not
        SAVEUSER,			!  by SIX12 code.
        SAVEJBUUO,

	PARSE,				! Indicates parse: infix,prefix, etc.
	ROUTN,				! Semantic action routine
	OPNAME;				! Print-name of the operator
    BIND
	LASTOP=	DBGSTK[.TOPOP-1]	: HBLOCK;

    PARSE = FIRSTONE( .LASTOP<PARSEFIELD> ) -32;

    SIXLC = SIXRC = SIXVC = 0;

    IF .PARSE AND .DBGSTK[.TOPSTK] GTR 0
    THEN
	BEGIN					! RIGHT OPERAND
	SIXRC = .DBGSTK[.TOPSTK];
	SIXRP = DBGSTK[.TOPSTK-.SIXRC];
	TOPSTK = .TOPSTK -.SIXRC -1
	END;

    ROUTN = .LASTOP[.PARSE,RH,0];
    OPNAME = .LASTOP[-1,FW];

    TOPOP = .DBGSTK[.TOPOP] AND %O'777777';		! 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];
	TOPSTK = .TOPSTK - .SIXLC -1
	END;

    ! The following state save/restore is required because
    ! in the case of user-defined operators, the dispatched
    ! routines could themselves contain debug linkages

    SAVEUSER = NOT WITHINSIX12(.ROUTN);
    IF .SAVEUSER
    THEN
        BEGIN
        ! We save and restore these only if a User Op because
        ! internal ops can change the state.  Only a user op
        ! cannot affect the SIX12 state except by recursive
        ! call, which is what this state saving is about
	!
        SAVEGO=.GOFLAG;
        SAVESTEP=.STEPFLAG;
        SETOFF(STEPFLAG);
        SAVETRACE=.TRACEFLAG;
        SETOFF(TRACEFLAG);
        SAVEJBUUO=.$JBUUO;
        GOFLAG=1
        END;

    IF .PARSEDEBUG
    THEN
	BEGIN
        OUTS('ex: ');
        PROP(.OPNAME);
        CRLF
        END;

    ( .ROUTN ) (.PARSE);			! Execute SEMANTIC Action

    IF .SAVEUSER
    THEN
        BEGIN
        $JBUUO = .SAVEJBUUO;
        TRACEFLAG = .SAVETRACE;
        STEPFLAG = .SAVESTEP;
        GOFLAG = .SAVEGO
        END;

    IF ISON(ERRORFLAG) THEN RETURN;

    IF .SIXVC GTR 0
    THEN
	BEGIN					! Get result of operation
	INCR J FROM 0 TO .SIXVC-1  DO DBGSTK[.TOPSTK+1 +.J] = .SIXVP[.J];
	TOPSTK = .TOPSTK+ .SIXVC +1;
	DBGSTK[.TOPSTK] = .SIXVC;
	IF .PARSEDEBUG THEN (OUTS('result: '); PRSTK(2))
	END
    END;
ROUTINE OPERATE(CURRNTOP: HBLOCK):NOVALUE=
!+
! FUNCTION
!	Schedule evaluation of operators on the DBGSTK
! INPUT
!	CURRNTOP	- New operator to either push or evaluate
!-
    BEGIN
    MACRO
	PRIO(OPWD,N)=
		BEGIN
		IF (.OPWD AND (1^N)) NEQ 0
		THEN
		    .OPWD[21-N, LH, 0]
		ELSE
		    0
		END%,

	BRACE(OPWD)=(.OPWD[1, LH, 0] GTR BRACEVAL) %,

	OPERAND=(.TOPSTK GEQ 0 AND .DBGSTK[.TOPSTK] GEQ 0) %,

	CHKPARSES(OP)= (IF .OP<PARSEFIELD> EQL 0 THEN RETURN ERROR(2)) %;

    LOCAL
	P,
	LBRACE;
    LABEL
	OPERANDTEST;

    SETOFF(LBRACE);
    P = PRIO(CURRNTOP, P_POSTFIX);			! Begin with POSTFIX

    IF .P EQL 0 THEN P = PRIO(CURRNTOP, P_INFIX);	! No POSTFIX, try INFIX

    UNTIL .TOPOP<17,1> DO	       		! While the stack isn't empty
	BEGIN
	BIND
	    LASTOP=DBGSTK[.TOPOP-1] : HBLOCK;
OPERANDTEST:
        BEGIN
        IF OPERAND
        THEN					! Found an operand between
	    BEGIN				!  this OP and previous one
	    LOCAL
		PARSE;

	    LASTOP = .LASTOP AND NOT MASK_(P_NULL, P_POSTFIX);
	    CHKPARSES(LASTOP);
	    PARSE = 21 - ( FIRSTONE( .LASTOP<PARSEFIELD> ) - 32);
	    IF PRIO(LASTOP,.PARSE) LSS .P THEN EXITLOOP
	    END
        ELSE
	    BEGIN
	    IF (.P EQL 0) OR BRACE(CURRNTOP)
	        OR ((.LASTOP AND MASK_(P_NULL, P_POSTFIX)) EQL 0)
	    THEN
	        BEGIN
	        IF BRACE(LASTOP) THEN LEAVE OPERANDTEST;
	        IF .CURRNTOP GEQ 0 THEN EXITLOOP
	        END;
	    LASTOP = .LASTOP AND NOT MASK_(P_PREFIX, P_INFIX);
	    CHKPARSES(LASTOP)
	    END;
        END %(OperandTest)%;

	IF  BRACE(LASTOP) AND (.CURRNTOP GEQ 0)
	THEN
	    IF .LASTOP[1,LH,0] EQL PRIO(CURRNTOP,P_POSTFIX) + BRACEVAL
	    THEN
		SETON(LBRACE)				! Onset of "compound"
	    ELSE
		EXITLOOP;

	EXECUTE();					! Previous operator
	IF ISON(ERRORFLAG) OR .LBRACE THEN RETURN
	END;

    ! Now stack the current operator
    !

    IF .CURRNTOP LSS 0 THEN RETURN;
    CURRNTOP = .CURRNTOP AND NOT (IF OPERAND
				THEN 
				    MASK_(P_NULL, P_PREFIX)
				ELSE
				    MASK_(P_POSTFIX, P_INFIX) );

    CHKPARSES(CURRNTOP);
    PUSHOPER(.CURRNTOP);				! Enter in eval stack

    ! If this is a NILARY or POSTFIX Parse, then we can execute it at once
    !
    IF (.CURRNTOP AND MASK_(P_PREFIX, P_INFIX)) EQL 0 THEN EXECUTE()

    END;
ROUTINE PDEBUG(PSWITCH)=
!+
! FUNCTION
!	Parse SIX12 command line and evaluate it
! INPUTS
!	PSWITCH	- Determines if result of expression evaluation should
!		  be printed (1) or suppressed (0)
! OUTPUTS
!	???	Possibly the number of entries to remove from the DBGSTK
!		at end of evaluation
!-
    BEGIN
    ROUTINE IGNORE:NOVALUE=WHILE .CHAR EQL %C' ' OR .CHAR EQL TAB DO ADVANCE();

    LABEL
	DECODE;
    LOCAL
	TFLAG,
	COUNT,
	QUALIFIER,
	SAWQUALIFIER;

    TOPOP = TOPSTK = -1;
    SETOFF(ERRORFLAG);
    QUOTFLG = MODEFLAG =  0;
    QUALIFIER = SAWQUALIFIER = 0;
    WHILE ISOFF(ERRORFLAG) DO
	BEGIN
	IF .QUALIFIER LSS 0
	THEN
	    BEGIN
	    QUALIFIER = -.QUALIFIER;
	    SAWQUALIFIER = 1
	    END
	ELSE
	    BEGIN
	    QUALIFIER = 0;
	    SAWQUALIFIER = 0
	    END;

	IGNORE();

	IF ENDOFLINE
	THEN
	    BEGIN
	    LOCAL
		RESLEN;

	    OPERATE(1^35);				! Clean up & stop
	    IF ISON(ERRORFLAG)
	    THEN
		(GOFLAG = 2;  RETURN 0);		! Never GO after error
	    IF .TOPSTK LEQ 0 THEN RETURN 0;

	    RESLEN = .TOPSTK - .DBGSTK[.TOPSTK];
	    IF ISON(PSWITCH)
	    THEN				! Print result
		INCR J FROM 0 TO .DBGSTK[.TOPSTK]-1  DO
		    BEGIN
		    PUTTAB;
		    OUTRDEF(.DBGSTK[.RESLEN+.J],14);
		    DBLEQL();
		    PRDISP(.DBGSTK[.RESLEN+.J]);
		    CRLF
		    END;
	    RETURN .DBGSTK[.RESLEN]
	    END;

     
	TFLAG = 0;
	IF .CHAR EQL %C'?'
	THEN
	    BEGIN
	    TFLAG = 1;
	    ADVANCE();
	    IF TYPE(.TFLAG) NEQ T_ALPHA THEN EXITLOOP ERROR(2)
	    END;

DECODE:
	BEGIN
	CASE TYPE(.TFLAG) FROM T_NUMBER TO T_OTHER OF
	    SET

	    [T_NUMBER]:
		BEGIN
		LOCAL
		    T,
		    NAME;

		IF .QUOTFLG GTR 0
		THEN
		    (ADVANCE();  LEAVE DECODE WITH ERROR(2));
		T = GETNUMBER();
		IGNORE();
		IF .CHAR EQL %C'%'		! Look for local or actual
		THEN				!  in form of
		    BEGIN			!	n%A - Actual parameter
		    ADVANCE();			!	n%L - STACKLOCAL
		    NAME = GETSYMBOL(.TFLAG);
		    SELECT .NAME OF
			SET
			[%RAD50_10 'A']:	T = GETARGADR(.T,0);
			[%RAD50_10 'L']:	T = GETLCLADR(.T,0);
			[OTHERWISE]:		LEAVE DECODE WITH ERROR(2);
			TES;
		    IF .T EQL -1 THEN LEAVE DECODE WITH ERROR(17);
		    END;
		PUSHITEM(.T)
		END;

	    [T_ALPHA]:
		!
		! GET A SYMBOL and HANDLE MACROS or QUALIFICATION
		!
		BEGIN
		LOCAL
		    NAME,		! RAD50 Symbol name
		    STE	: SYMBOL,
		    PCT_N;		! Indicate SYMBOL%n to get n-th
					!  definition of "SYMBOL"

		NAME = GETSYMBOL(.TFLAG);

		IF (QUOTFLG = .QUOTFLG-1) GEQ 0
		THEN
		    LEAVE DECODE WITH PUSHITEM(.NAME);

		IGNORE();

		IF .CHAR EQL %C'\'
		THEN
		    BEGIN
		    IF .NAME EQL 0 
		    THEN
			!+**************************************+!
			! Don't think this can EVER execute	 !
			!-**************************************-!
			BEGIN
			ISHIGHSYMBOLTABLE();
			IF .GQUALIFIER EQL 0 OR .HQUALIFIER EQL .$JBSYM OR
				.HQUALIFIER EQL .HCACHE
			THEN
			    QUALIFIER = .GQUALIFIER
			ELSE
			    LEAVE DECODE WITH ERROR(36)
			END
		    ELSE
			BEGIN
			QUALIFIER = FINDMODULE(.NAME);
			IF .QUALIFIER EQL 0 
			THEN
			    LEAVE DECODE WITH ERROR(0)
			END;
		    ADVANCE();
		    TFLAG = 0;
		    IF .CHAR EQL %C'?'
		    THEN
			BEGIN
			TFLAG = 1;
			ADVANCE();
			IF TYPE(.TFLAG) NEQ T_ALPHA
			THEN
			    LEAVE DECODE WITH ERROR(2)
			END;
		    NAME = GETSYMBOL(.TFLAG);
		    SAWQUALIFIER = 1
		    END;

		IF .CHAR NEQ %C'%' AND NOT .SAWQUALIFIER
		THEN
		    BEGIN
		    ! Look for Macro definition
		    DECR J FROM .NNAMES TO 0 DO
			IF .SIXNAMES[.J,MACRO_NAME] EQL .NAME
			THEN
			    !+
			    ! Back up byte-pointer in current input stream and
			    ! change to the MACRO stream
			    !-
			    BEGIN
			    PCHAR[.NPCHAR] = CH$PLUS( .PCHAR[.NPCHAR], -1);
			    NPCHAR = .NPCHAR+1;
			    PCHAR[.NPCHAR] = CH$PTR(.SIXNAMES[.J,MACRO_BODY]);
			    ADVANCE();
			    LEAVE DECODE
			    END;
		    END;

		! Have "%" or Non-Macro
		PCT_N = -1;			! Allows operator or user name
		IF .CHAR EQL %C'%'
		THEN
		    BEGIN
		    ADVANCE();
		    IF .SAWQUALIFIER THEN LEAVE DECODE WITH ERROR(2);	! may not use "%" if "\" seen
		    PCT_N = GETNUMBER();
		    IF ISON(ERRORFLAG) THEN LEAVE DECODE
		    END;

		IF .PCT_N LEQ 0 AND NOT .SAWQUALIFIER
		THEN
		    ! look for operator
		    BEGIN
		    LOCAL
			CODING;			! Operator encoded value
		    CODING = GETNAMEOP(.NAME);
		    IF .CODING GTR 0
		    THEN
			LEAVE DECODE WITH OPERATE(.CODING)
		    ELSE
			IF .PCT_N EQL 0 THEN LEAVE DECODE WITH ERROR(0);
		    IF .CODING EQL -2 THEN LEAVE DECODE WITH ERROR(25)
		    END;

		IF .PCT_N EQL -1
		THEN
		    ! Unqualified or \-qualified  name
		    BEGIN
		    LOCAL
			FIRSTTRY,
			HOLD	: SYMBOL,
			PREVSYM	: SYMBOL;

		    FIRSTTRY = 1;
		    HOLD = .QUALIFIER;
		    PREVSYM = 0;
		    WHILE 1 DO
			BEGIN
			HOLD = NSDDTFA(.NAME,.HOLD);
			IF .HOLD EQL 0
			THEN
			    BEGIN
			    IF NOT .FIRSTTRY THEN EXITLOOP;
			    !+
			    ! This is the first time thru the loop.  If we
			    !  found a symbol, save it and look to see if more
			    !  than one symbol matches (that would be an error)
			    !-
			    IF .PREVSYM NEQ 0 THEN EXITLOOP;
			    HOLD = 0;
			    FIRSTTRY = 0
			    END;
			IF .HOLD[RAD50FLAG] NEQ 0
			THEN
			    IF .PREVSYM EQL 0
			    THEN
				PREVSYM = .HOLD
			    ELSE 
				!+
				! If values differ for multiply defined symbols
				!  we will complain.  Otherwise, we allow any
				!  number of occurances of the same value here.
				! Further, if a definition is coming from a
				!  HISEG, we will take it even if it differs
				!  from a LOSEG symbol-table value.
				!-
				IF .HOLD[VALUEWRD] NEQ .PREVSYM[VALUEWRD]
				THEN
				    IF ISHIGHSYMBOLTABLE() AND
					.PREVSYM<RH> GEQ .HCACHE<RH> AND	! hiseg for previous
					.HOLD<RH> LSS .HCACHE<RH>	! lowseg for this one
				    THEN
					0   ! skip
				    ELSE
					LEAVE DECODE WITH (ERRORPARM = .HOLD[RAD50NAME];  ERROR(22))
			END;
		    ! If we get here, PrevSym is either undefined, or
		    ! is the symbol table address of the unique symbol
		    IF .PREVSYM EQL 0
		    THEN
			LEAVE DECODE WITH ERROR(0)
		    ELSE
			LEAVE DECODE WITH PUSHITEM(.PREVSYM[VALUEWRD])
		    END;

		! Must be %-qualified user symbol
		!
		STE = 0;		! to start symbol search
		COUNT = .PCT_N;
		WHILE .COUNT NEQ 0 DO
		    BEGIN
		    STE = NSDDTFA(.NAME,.STE);
		    IF .STE EQL 0 THEN LEAVE DECODE WITH ERROR(0);
		    IF .STE[RAD50FLAG] NEQ DDT$_MODULE
		    THEN
			COUNT = .COUNT-1;	! skip module names
		    END;
		PUSHITEM(.STE[VALUEWRD])
		END;

	    [T_RADIX]:
		!+
		! Implements numeric over-ride with the "#" symbol.  If current
		! radix is decimal, number will be handled as octal (and vice
		! versa).
		!-
		BEGIN
		LOCAL
		    SAVEDBASE;

		IF .QUOTFLG GTR 0
		THEN
		    (ADVANCE();  LEAVE DECODE WITH ERROR(2));
		IOBASE = ( IF (SAVEDBASE = .IOBASE) EQL 8 THEN 10 ELSE 8 );
		ADVANCE();
		PUSHITEM(GETNUMBER());
		IOBASE = .SAVEDBASE
		END;

	    [T_QUOTE]:
		BEGIN
		GETSTRING()
		END;

	    [T_OTHER]:
		BEGIN
		LOCAL
		    CODING;

		IF .CHAR EQL %C'\'
		THEN
		    BEGIN
		    ISHIGHSYMBOLTABLE();
		    IF .GQUALIFIER EQL 0 OR .HQUALIFIER EQL .$JBSYM OR
			.HQUALIFIER EQL .HCACHE
		    THEN
			QUALIFIER = -.GQUALIFIER;
		    ADVANCE();
		    LEAVE DECODE
		    END;
		IF .CHAR EQL %C'='
		THEN
		    BEGIN
		    QUOTFLG = 0;
		    IF .MODEFLAG EQL 0 THEN MODEFLAG = 4
		    END;

		CODING = GETOP(.CHAR^18);
		ADVANCE();
		IF .CODING LSS 0 THEN ERROR(1) ELSE OPERATE(.CODING)
		END
	    TES
	END			!*** End DECODE ***
	END;
    CHAR = CR;
    0
    END;
ROUTINE INPUT = 
!+
! FUNCTION
!	Read next input line from "debugging" input
!-
    BEGIN
%IF TOPS20
%THEN
    OWN
	TXIBUF:	VECTOR[$RDBKL+1];
%FI
    LOCAL
	CCOUNT;

    CCOUNT = 0;		! we use this locally for counting non-LFs

    PCHAR[0] = CH$PTR(BUFF);
    SAWCR = 0;
    SAWEOF = 0;

    IF ISON(DISKIFLAG)
    THEN
	BEGIN
	DO 
	    BEGIN
	    CHAR = INCHARS();
	    CH$WCHAR_A( .CHAR, PCHAR[0] );
	    CCOUNT = .CCOUNT+1;
	    IF ANYLPT() THEN LPTOUT(.CHAR);
	    IF .CHAR EQL CR THEN SAWCR = 1;
	    IF .CHAR EQL -1 THEN SAWEOF = 1
	    END
	UNTIL .CHAR EQL LF OR .CHAR EQL -1;
	CH$WCHAR( CR, .PCHAR[0] )
	END
    ELSE
	! Read from terminal instead...
	!
	BEGIN
%IF TOPS10
%THEN
	DO
	    BEGIN
	    CHAR = INC;
	    CH$WCHAR_A( .CHAR, PCHAR[0] );
	    CCOUNT = .CCOUNT + 1;
	    IF .CHAR EQL CR THEN SAWCR = TRUE
	    END
	UNTIL .CHAR EQL LF;
	IF ANYLPT() THEN OUTSA(CH$PTR(BUFF));	! Echo to LPT as needed
	CH$WCHAR( CR, .PCHAR[0] )
%ELSE
	TXIBUF[$RDCWB] = $RDBKL;		! Number of words following
	TXIBUF[$RDFLG] = RD_BEL+RD_JFN+RD_BBG;	! Break on CRLF, JFN supplied
	IF ISON(DISKIFLAG)
	THEN
	    TXIBUF[$RDIOJ] = .DSKHDR^18 + $NULIO	! Read from DSK:
	ELSE
	    TXIBUF[$RDIOJ] = $PRIIN^18+$PRIOU;	! Use controlling terminal

	TXIBUF[$RDDBP] = CH$PTR(BUFF);		! Destination string
	TXIBUF[$RDDBC] = BUFFERSIZE*5;		!  and size
	TXIBUF[$RDBFP] = CH$PTR(BUFF);		!
	TXIBUF[$RDRTY] = MSG('&');		! ^R retype prompt string
	TXIBUF[$RDBRK] = 0;			! No break chars supplied
	TXIBUF[$RDBKL] = CH$PTR(BUFF);		! Back up limit

	TEXTI( TXIBUF );

	CCOUNT = BUFFERSIZE*5 - .TXIBUF[$RDDBC];! compute bytes read
	IF ANYLPT() THEN OUTSA(CH$PTR(BUFF));	!  and echo to lpt

	IF SCANN(TXIBUF[$RDDBP]) EQL LF
	THEN
	    BEGIN
	    LOCAL
		PTR;

	    BKJFN( .TXIBUF[$RDDBP] ; PTR );
	    IF SCANN(PTR) EQL CR
	    THEN
		BEGIN
		SAWCR = 1;
		CCOUNT = .CCOUNT-1
		END
	    END;
	REPLACEN(TXIBUF[$RDDBP], CR);	! Overwrite LF with CR
%FI
	END;

    PCHAR[0] = CH$PTR(BUFF);
    NPCHAR = 0;
    IF NOT .SAWCR AND NOT .SAWEOF
    THEN
	BEGIN
	LOCAL
	    Q;
	Q = .PCHAR[0];
	IF CH$RCHAR_A(Q) EQL CR THEN SAWCR = 0
	END;
    IF NOT .SAWCR AND NOT .SAWEOF AND .CCOUNT LEQ 1
    THEN
	BEGIN %(want step)%
	PCHAR[0] = MSG('STEP',%CHAR(13));
	OUTC(CR);
	END %(want step)%;
    ADVANCE();
    NCHAR = 0
    END;
ROUTINE PROMPT:NOVALUE=
!+
! FUNCTION
!	Display prompt for debugger command inputs, with indication of
!		Depth of debugger invocations (if not top-level)
!		Output logging to DSK or LPT
!		Whether DEBUG UUO handling is disabled
!-
    BEGIN
    IF .DEPTH GTR 1
    THEN
	BEGIN
	TTOUTDEC(.DEPTH);
	TTOUTC(%C':')
	END;

    IF LPTOUTTING() THEN TTOUTC(%C'-');
    IF .$JB41 EQL DBG_OFF_INST THEN TTOUTC(%C'N');
    TTOUTC(%C'&')
    END;
ROUTINE ISUB=
!+
! FUNCTION
!	Drives syntax analyzer and polls terminal for interrupting command
!	lines.
! OUTPUTS
!	0	- Indicates normal return to caller
!
!	1	- Indicates SET_UNWIND done by ISUBSIG to ISUB's caller
!
!-
    BEGIN
    ENABLE
	ISUBSIG;		! Establish condition handler

    DEPTH = .DEPTH + 1;

    IF ((DCNT = .DCNT-1) LEQ 0) OR .TRACEFLAG
    THEN
	! If we have hit the BGOBASE-th DEBUG UUO and should do further
	! checking on this "sample", or if we are tracing each routine,
	! then come in here...
	!
	BEGIN
	IF .DCNT LEQ 0 THEN (DCNT = BGOBASE;  INCRTOG);	! Set to sample again

	IF ISON(ENABFLAG) AND ISOFF(NOPOLLFLAG)		! Want to check for
	THEN						!  unsolicited TTY:
	    BEGIN					!  input.
%IF TOPS10
%THEN
	    IF SKPINL() THEN (STOPIT();  GOFLAG = 0);
%ELSE
	    IF NOT SIBE($PRIIN)
	    THEN
		(STOPIT();  PROMPT(); GOFLAG = 0)
%FI
	    END
	END;

    UNTIL .GOFLAG DO
	BEGIN
	DO
	    ! Read input until we find something that isn't a "comment"
	    !
	    BEGIN
	    IF .GOFLAG GTR 0 THEN PROMPT();	! Don't prompt on "interrupt"
	    INPUT()
	    END
	UNTIL .CHAR NEQ %C'!';

	IF ISOFF(DISKIFLAG) THEN GOFLAG = 2;
	IF NOT .SAWEOF THEN PDEBUG(1) ELSE GOFLAG = 1;
	TOPOP = TOPSTK = -1;		! Fudge to ensure proper (?) operation
					! if SIX12 is entered recursively.
	END;

    DEPTH = .DEPTH -1;
    RETURN 0;		! if we return out of here, we leave SIX12
    END;
%SBTTL	'Entry into SIX36'
!	------------------

OWN
    ROUTPNT:	REF BLOCK FIELD(ROUT_FIELDS),
    CONDPNT;					! Ptr to conditional action
						!  text.
GLOBAL ROUTINE SIXXEQ(STR)=			
!+
! FUNCTION
!	Pass a command string to SIX36 for execution
! INPUT
!	STR	- Address of an ASCIZ string
!- 
    BEGIN
    LOCAL
	RETVAL;

    IF NOT ISADDRESS(.STR) THEN RETURN 0;	! Not addressable
    IF .STR EQL 0 THEN RETURN 0;		!  or invalid pointer

    NPCHAR = 1;
    PCHAR[1] = CH$PTR(.STR);			! First command to execute
    PCHAR[0] = MSG(%CHAR(CR,CR,LF));		!  followed by a "step" command
    ADVANCE();
    NCHAR = 0;

    ! Invoke parser, but don't print the top-level result.
    !

    RETVAL = PDEBUG(0);

    TOPOP = TOPSTK = -1;

    .RETVAL
    END;
ROUTINE CHKCOND=
!+
! FUNCTION
!	Check condition for action.
! OUTPUTS
!	T/F	Indicates if conditional expression is TRUE or FALSE
!-
    BEGIN
    LOCAL
	RETVAL;

    IF .CONDPNT EQL 0 THEN RETURN 1;	! Unconditional return

    NPCHAR = 1;				! Make input stream be the conditional
    PCHAR[1] = CH$PTR(.CONDPNT);	!  expression, followed by a "STEP"
    PCHAR[0] = MSG(%CHAR(CR,CR,LF));	!  command as previous stream
    ADVANCE();
    NCHAR = 0;

    RETVAL = PDEBUG(0);			! Evaluate the expression
    TOPOP = TOPSTK = -1;	

    .RETVAL				! The result of the conditional expr.
    END;
ROUTINE RTRCAFT:NOVALUE=
    BEGIN
    IF ISEXIT
    THEN
	! Check for TRACE where trace-count expires
	!
	(IF .ROUTPNT[IDIDONF] AND (TRCCNT = .TRCCNT-1) LEQ 0
	 THEN
	    TRACEFLAG = ROUTPNT[IDIDONF] = 0)
    ELSE
	IF .OPQCNT LEQ 0 AND .TRACEFLAG GEQ 0
	THEN
	    (IF CHKCOND()
	     THEN
		(ROUTPNT[IDIDONF] = 1;  TRCCNT = 1;  TRACEFLAG<RH> = -1)
	    )
	ELSE
	    IF .ROUTPNT[IDIDONF] THEN TRCCNT = .TRCCNT+1
    END;
ROUTINE RTRCAT: NOVALUE=
    BEGIN
    IF .OPQCNT LEQ 0 AND .TRACEFLAG GEQ 0
    THEN
	IF CHKCOND() THEN TRACEFLAG = .TRACEFLAG OR NOT 1
    END;
ROUTINE ROPQAFT:NOVALUE=
    BEGIN
    IF ISEXIT
    THEN
	BEGIN
	IF .ROUTPNT[IDIDOFFF] AND (OPQCNT = .OPQCNT-1) LEQ 0
	THEN
	    BEGIN
	    TRACEFLAG = -.ROUTPNT[PREVOFFF] AND NOT 2;
	    STEPFLAG = -.ROUTPNT[PREVSTEPF] AND NOT 2;
	    ROUTPNT[IDIDOFFF] = ROUTPNT[PREVOFFF] = ROUTPNT[PREVSTEPF] = 0
	    END
	END
    ELSE
	IF .OPQCNT LEQ 0
	THEN
	    BEGIN
	    IF CHKCOND()
	    THEN
		BEGIN
		ROUTPNT[IDIDOFFF] = 1;
		ROUTPNT[PREVOFFF] = .TRACEFLAG;
		ROUTPNT[PREVSTEPF] = .STEPFLAG;
		OPQCNT = 1;
		STEPFLAG<RH> = 0;
		TRACEFLAG<RH> = 0
		END
	    END
	ELSE
	    IF .ROUTPNT[IDIDOFFF] THEN OPQCNT = .OPQCNT+1
    END;
ROUTINE ROPQAT: NOVALUE=
    BEGIN 
    IF .STEPFLAG LSS 0 THEN STEPFLAG = .STEPFLAG AND 1;
    IF .TRACEFLAG LSS 0 AND CHKCOND()
    THEN
	TRACEFLAG = .TRACEFLAG AND 1
    END;
ROUTINE RTABREAK: NOVALUE=
!+
! FUNCTION
!	Do necessary processing to RETURN from an ABREAK-point
!-
    BEGIN
    IF ISEXIT
    THEN
	BEGIN
	STOPIT();
	IF NOT .REPORTED
	THEN
	    BEGIN
	    OUTS(%CHAR(CR,LF),'<=> After: ');
	    PRXDISP(.RNAME);
	    IF ISNOVALUE			! Give appropriate message
	    THEN				!  for a NOVALUE routine, or
		SHOWNOVALUE()			!  show the value which is
	    ELSE				!  being returned.
		OUTVALUE(.SIXVREG);
	    REPORTED = 1
	    END;

	! now, remove the TABREAK from the routine
	!
	DSTABREAK(.RNAME)
	END
    END;
ROUTINE RABREAK:NOVALUE=
!+
! FUNCTION
!	Process RETURN from ABREAK points
!-
    BEGIN
    IF ISEXIT AND CHKCOND()
    THEN
	BEGIN
	STOPIT();  
	IF NOT .REPORTED
	THEN
	    BEGIN
	    OUTS(%CHAR(CR,LF),'<=> After: ');
	    PRXDISP(.RNAME);  
	    IF ISNOVALUE THEN SHOWNOVALUE() ELSE OUTVALUE(.SIXVREG);
	    REPORTED = 1
	    END
	END
    END;
ROUTINE RBREAK : NOVALUE=
!+
! FUNCTION
!	Report a ROUTINE Break
!-
    BEGIN
    IF NOT ISEXIT AND CHKCOND()
    THEN 
        BEGIN
        STOPIT();  
        IF NOT .REPORTED
        THEN
	    BEGIN
	    OUTS(%CHAR(CR,LF),'<=> At: ');  
	    PRCALL(.ENTERPNT[NEXT_FRAME], .RNAME);  
	    CRLF;
	    REPORTED = 1
	    END
        END
    END;
! Dispatch vector for action routines.  This must be updated if
! additional action bits are added.  Notice that it is indexed with
! an implicit offset of 18. (the UPLIT(..)-18).

BIND
    RTNSPLIT=
	    UPLIT(
		%( bit 18 action )%	RBREAK,
		%( bit 19 action )%	RABREAK,
		%( bit 20 action )%	ROPQAT,
		%( bit 21 action )%	ROPQAFT,
		%( bit 22 action )%	RTRCAT,
		%( bit 23 action )%	RTRCAFT,
		%( bit 24 action )%	RTABREAK,
		%( remaining bits )%	REP 11 OF(DOTVREG)
	    )-18 : VECTOR;
ROUTINE CALLENABLED(FRAME: REF VECTOR, EXITCODE, HANDLER, CALLEE)=
!+
! FUNCTION
!	This is a VERY DELICATE piece of code. It is the FIRST PLACE you
!	should look if the signal handler in SIX12 starts blowing up.
!	Critical assumption is that NO LOCALS and NO REGISTERS are declared,
!	so only .ENT.0 is called by this routine to set up the Frame Pointer
!	for the arguments.
!	This is important, because the ExitHandler routine, which is called
!	via a JRST (!) instruction from the unwinder, assumes it can POP
!	 to clean up the stack
!
!	It is passed a 4-word "enable frame" pointer.  The frame is set up
!	to hold the 2-word enable stack frame and the 2-word dispatch vector.
!	It is the responsibility of the caller to unlink the exception
!	frame pointer if this is desired.
!
!	+----------------------+
!	| exit code addr       | 3
!	+----------------------+
!	| handler code addr    | 2 <----+
!	+----------------------+	|
!	| dispatch pointer     | 1 -----+
!	+----------------------+
!	| efpnt. link	  | 0
!	+----------------------+
!
    BEGIN
    FRAME[0] = .EFPNT$;
    FRAME[1] = FRAME[2];
    FRAME[2] = .HANDLER<RH>;
    FRAME[3] = .EXITCODE<RH>;

    EFPNT$ = FRAME[0];

    (.CALLEE)()
    END;


ROUTINE EXITHANDLER:NOVALUE=
!+
! FUNCTION
!	This is a delicate routine.  It assumes that no call is
!	made on any of .ENT.0 ... etc. so that the pops
!	will undo the stack in the correct manner for the enable
!	frame established by CallEnabled
!
!-
    BEGIN
    POP(SREG,EFPNT$);
    POP(SREG,FREG);
    POPJ(SREG,0)
    END;
ROUTINE B36ISUB:NOVALUE=
!+
! FUNCTION
!	The purpose of this loop is to handle the case of
!	an UNWIND when the SIGNAL was intercepted by the
!	SIX12 condition handler, i.e., we are unwinding back
!	to SIX12.  If we are doing an UNWIND, the value returned
!	is 1, so we re-enter the command scanner; otherwise
!	the value is 0, so we assume that we got here because
!	we left the command loop in ISUB.
!-
    BEGIN
    LOCAL
        SAVE:	VECTOR[4];

    SAVE[0] = .ENTERPNT;
    SAVE[1] = .RTNLVL;
    SAVE[2] = .INSIXHDR;
    SAVE[3] = .ENTERSP;

    WHILE ISUB() DO
	!+
	! An UNWIND has occurred.  Restore importint info about the current
	!  invocation of SIX36 and give another command prompt at the present
	!  level.
	!-
        BEGIN
        ENTERPNT = .SAVE[0];
        RTNLVL = .SAVE[1];
        INSIXHDR = .SAVE[2];
	ENTERSP = .SAVE[3];
        GOFLAG=2
        END
    END;
ROUTINE ISUBSIG(SIGNL: REF VECTOR,MECH: REF VECTOR,ENBL)=
!+
! FUNCTION
!
!	We get here under several conditions:
!
!	> We are handling a signal which has been generated by
!	someone SIX12 called.
!
!	> We are the first intercept of a SIX12-generated SIGNAL
!
!	> We are doing an UNWIND to ourself
!
!	> We are doing an UNWIND to some outer handler
!
!
!	SIGNL[1] is the signal value
!
!	The cleanup on an UNWIND consists of decrementing the
!	depth counter
!-
    BEGIN
    REGISTER
	SAVER;			! This must be a register
    LOCAL
	SAVE:	VECTOR[6];
    BUILTIN
	SP, FP;
    MACRO
	RETURNVALUE(X)=
			BEGIN 
			RTNLVL = .SAVE[1]; 
			ENTERPNT = .SAVE[2]; 
			INSIXHDR = .SAVE[3];
			RNAME = .SAVE[4];
			ENTERSP = .SAVE[5];
			RETURN (X) 
			END %;

    SAVER = .SIXVREG;
    SIXVREG = .VREG;

    SAVE[1] = .RTNLVL;
    SAVE[2] = .ENTERPNT;
    SAVE[3] = .INSIXHDR;
    SAVE[4] = .RNAME;
    SAVE[5] = .ENTERSP;

    ENTERPNT = .FP<RH>;			! Point to current frame chain
    ENTERSP = SIGNL;			! SP where this frame's arglist starts?

    IF .SIXSTK EQL 0 THEN SIXSTK = .SP;	! Set up valid saved SP

    IF .SIGNL[1] EQL SIXUNWSIGNAL
    THEN
	BEGIN %(start unwind)%
	IF (WHACKS = .WHACKS - 1) LEQ 0 
	THEN
	    BEGIN
	    ! we've reached the depth we want
	    !
	    SETON(WHACKING);
	    SETUNWIND();
	    RETURNVALUE(1)
	    END;
	RETURNVALUE(0)		! resignal
	END %(start unwind)%;
    !
    ! We would like to make this test based on the (signl)[2]
    ! value, which should be the PC of the signal caller, but
    ! which does not currently exist.
    !
    !
    !	Otherwise, a fairly conventional signal
    !
    IF WITHINSIX12(GETCALLFROM(.ENTERPNT[NEXT_FRAME])) AND ISOFF(WHACKING)
    THEN 
	! This handles the case of the SIGNAL command
	! from SIX12, so we don't get an unnecessary
	! call to the user
	!
	RETURN 0;
    
    IF .SIGNL[1] EQL .UNWINDVALUE 
    THEN
	BEGIN %(unwinding)%
	IF ISOFF(WHACKING)
	THEN
	    BEGIN
	    OUTS('SIX12: Unwinding level ');
	    OUTD(.DEPTH);
	    OUTCRLF()
	    END;

	DEPTH = .DEPTH -1;
	MECH[1] = 1;		! if unwinding to ourself,
				    ! this will cause SIX12 to
				    ! be re-invoked, else it does
				    ! nothing
	RETURNVALUE(1)
	END %(unwinding)%;

    IF .SIGNL[1] EQL .UNWINDVALUE THEN RETURNVALUE(0);

    !	If we get a signal, we first report it and call ourself
    !	recursively, and then resignal upon return.  
    !
    !	If we had the PC in the signl vector, we could determine that
    !	the signal came from SIX12, and could punt doing this
    !	call (and could provide useful information when we were not
    !	handing a SIX12-generated signal, like where it came from!)
    !
    
    OUTS('SIX12 signal handler called from ');
    PRDISP(GETCALLFROM(.ENTERPNT[NEXT_FRAME]));
    OUTS(' with signal ');
    OUTDEFAULT(.SIGNL[1]);
    OUTCRLF();

    STOPIT();
    B36ISUB();

    RTNLVL = .SAVE[1];
    ENTERPNT = .SAVE[2];
    INSIXHDR = .SAVE[3];
    RNAME = .SAVE[4];
    ENTERSP = .SAVE[5];

    EXCH(SAVER,SIXVREG);
    RETURN 0;					! resignal
    END;
ROUTINE OUTERHANDLER(SIGNL: REF VECTOR,MECH: REF VECTOR,ENBL)=
!+
! FUNCTION
!	This routine is enabled by INITSIX12 to catch an
!	otherwise unintercepted signal.  Its default action
!	(unlike ISubSig) is to RESUME!!!!
!-
    BEGIN
    REGISTER
        SAVER;
    LOCAL
        SAVE:	VECTOR[6];

    SAVER = .SIXVREG;
    SAVE[1] = .RTNLVL;
    SAVE[2] = .ENTERPNT;
    SAVE[3] = .INSIXHDR;
    SAVE[4] = .$JBUUO;			! Must save 36 bits so that
    SAVE[5] = .ENTERSP;				!  flags are preserved.

    ENTERPNT = .FREG<RH>;

    OUTS('SIX12 outermost signal handler called ');

    IF .SIGNL[1] EQL .UNWINDVALUE
    THEN
        OUTS('during UNWIND')
    ELSE
        BEGIN
        OUTS('from ');
        PRDISP(GETCALLFROM(..ENTERPNT));
        OUTS(' with signal ');
        OUTDEFAULT(.SIGNL[1])
        END;
    OUTCRLF();

    STOPIT();
    B36ISUB();

    RTNLVL= .SAVE[1];
    ENTERPNT = .SAVE[2];
    INSIXHDR = .SAVE[3];
    $JBUUO = .SAVE[4];
    ENTERSP = .SAVE[5];

    EXCH(SAVER,SIXVREG);

    RETURN 1;						! resume
    END;
%SBTTL	'DEBUG. UUO Processing'
LINKAGE
    SAVEMOST=	PUSHJ: LINKAGE_REGS(SREG,FREG,VREG)
			PRESERVE(PRREGS,NPREGS);	! Saves all ACs

ROUTINE CALLEM(DUMMY) : SAVEMOST=
!+
! FUNCTION
!       This routine does the bulk of the work in processing a DEBUG. UUO.
!       It is separate from UUOH, as it is allowed to allocate stack storage
!       and will be JRST-ed to from UUOH
! INPUTS
!	DUMMY	- Dummy formal parameter, such that we can easily determine
!		  our SP before the routine saves any registers, etc.
! NOTES
!	One piece of obscurity is the requirement that this procedure must
!	have a "saved" FP generated for itself.  This insures that the
!	ENTERPNT really points to the correct place, such that RETURN et al
!	will continue to work.
!
!-
    BEGIN
    REGISTER
	RSAVE;
    LOCAL
	SAVE:	VECTOR[4],
	L;
    BUILTIN
	FP;

    RSAVE = .SIXVREG;
    REPORTED = 0;				! nothing yet said
    HCACHE = 0;					! invalidate hiseg sym cache
    SIXVREG = .VREG;
    SAVE[0] = .RTNLVL;
    SETISEXIT();
    SAVE[1] = .ENTERPNT;
    SAVE[2] = .DISKIFLAG;			! turn off disk input
    SAVE[3] = .ENTERSP;
    IF .INSIXHDR THEN RETURN .RSAVE;
    SETOFF(DISKIFLAG);
    ENTERPNT = .FP;
    ENTERSP = DUMMY-1;				! Ignore the FP when computing
						!  stack at entry

    WHACKS = 0;					! for unwinding 
    SETOFF(WHACKING);
    IF .NVALS GEQ 0 THEN CKVALS(.RNAME, .RTNLVL);
    IF ISINTBL			  		! Marked as 'interesting'
    THEN
	IF (L = CFINDR(.RNAME)) GEQ 0   	! Look-up the routine in the
	THEN			    		!  action table to see what
	    BEGIN				!  kind of break|trace this is
	    ROUTPNT = ROUTS[.L,ROUT_INFO];
	    DECR J FROM MAXACTRTN TO 18 DO
		IF .ROUTPNT[INTEREST(.J)]	! Interested in this event
		THEN
		    BEGIN
		    CONDPNT = .ROUTPNT[CNDACTION(.J)];	! Set conditional
							!  action text ptr
		    (.RTNSPLIT[.J]) ()
		    END
	    END;


    IF .TRACEFLAG LSS 0 AND NOT .REPORTED AND .STEPFLAG EQL 0
    THEN
	IF ISEXIT 
	THEN
	    BEGIN
	    IF .TRACEFLAG<1,1>
	    THEN
		BEGIN
		OUTS('<-- ');
		PRXDISP(.RNAME)
		END;
	    IF ISNOVALUE THEN SHOWNOVALUE() ELSE OUTVALUE(.SIXVREG)
	    END
	ELSE
	    BEGIN
	    OUTS('--> ');
	    PRCALL(.ENTERPNT[NEXT_FRAME],.RNAME);
	    IF .TRACEFLAG<1,1> THEN CRLF
	    END;

    IF .STEPFLAG LSS 0
    THEN
	IF ISEXIT
	THEN
	    RABREAK()
	ELSE
	    RBREAK();

    ! The following two statements handle the opaque manipulations
    ! by converting the value 1 in TraceFlag and StepFlag to -1 when
    ! appropriate
    !
    IF .TRACEFLAG THEN SETON(TRACEFLAG) ELSE SETOFF(TRACEFLAG);
    IF .STEPFLAG THEN SETON(STEPFLAG) ELSE SETOFF(STEPFLAG);

    B36ISUB();

    RTNLVL = .SAVE[0];
    ENTERPNT = .SAVE[1];
    DISKIFLAG = .SAVE[2];
    ENTERSP = .SAVE[3];

    EXCH(RSAVE,SIXVREG)
    END;
ROUTINE UUOH: NOVALUE=
!+
! FUNCTION
!	DEBUG UUO handler.
!
! NOTES
!	This routine MUST not HAVE ANY Local, Register, or DYNAMIC Bind 
!	DECLARATIONS which would cause registers to be saved.
!	Further, it should not modify ANY registers, in case GLOBAL REGISTERs
!	or input-output parameters are present.
!
!	This routine does use a couple of registers while implemented field
!	references via Load Byte and Deposit Byte instructions.  In this case,
!	it is necessary to explicitly save/restore those registers in OWN
!	storage. 
!
!	In short, to know whether or not any registers are being smashed, it
!	is necessary to look at the code produced.
!-
    BEGIN
    BUILTIN
	SP, FP;
    REGISTER
	RETVAL=	VREG,
	RSAVE;			! We need at least one NOPRESERVE REGISTER
    OWN
	SAVED_AC,		!  and we will preserve it here

	SAVE_AC2;		! Sometimes we need to save/restore AC2.
				!  Actually, when %VARIANT EQL 10, we use AC1
				!  instead of AC2.
    MAP
	$JBUUO	: $INSTRUCTION;

%IF EXTENDED
%THEN
    PUSH(SP, SWT[$AROPC,FW]);		! Make non-zero "trap" look like
%FI					!  regular "call" to entrypoint.
	
    SAVED_AC = .RSAVE;			! Save otherwise unpreserved register

    RETVAL = .RETVAL;			! Tie up VREG across body of routine

    RSAVE = .INSIXHDR;			! Copy to register for safety

    IF .RSAVE OR ((SIXTOG = .SIXTOG-1) GTR 0 AND .STEPFLAG EQL 0 )
    THEN 
	BEGIN
	DCNT = .DCNT-1; 
	RSAVE = .SAVED_AC;
	POPJ(SP,0)
	END;

    MACHOP( %O'202', S1036(1,2), SAVE_AC2 );	! MOVEM AC2,SAVE_AC2.

%IF NOT EXTENDED
%THEN
    BEGIN
    MAP
	RSAVE	: $INSTRUCTION;

    RSAVE = ..SP;			! Get return address
    SWT[$AROPC,FW] = .RSAVE<RH>;	!  and store into dummy SWTRP% block
    SWT[$ARPFL,LH,0] = .RSAVE<LH>;	! Also get flags,

    RSAVE = .$JBUUO;			! Get offending instruction
    SWT[$AREFA,FW] = .RSAVE[M_OFFSET];	!  and save effective adr in DEBUG. UUO
    SWT[$ARPFL,9,9,0] = .RSAVE[M_REGF];	!  and the AC used
    END;
%ELSE
    RSAVE = .SWT[$AROPC,FW];		! Continuation PC
    RSAVE = .(.RSAVE-1);		! The DEBUG. UUO
    $JBUUO = .RSAVE;
%FI

    RSAVE = .$JBUUO;			! Force into my preserved temp reg.

    IF NOT (.RSAVE AND BITVAL(EXITPOS)) NEQ 0
    THEN
	BEGIN				! This is a ROUTINE-entry DEBUG. UUO
	BIND
	    P= RSAVE: REF $INSTRUCTION;
	OWN
	    ECNT;
	REGISTER			! This register is saved/restored
	    OPCODE = S1036(1,2);	!  outside this block.

	! Pop the return address off the stack so that the stack-depth
	!  will be identical to that expected after the DEBUG UUO returns.
	!  This allows us to XEQ the prolog code with the proper context
	!

	POP(SP,P);			! Get pushed address back

	OPCODE = .P[M_LHALF];

	IF .OPCODE EQL CAIOP^9
	THEN
	    !+
	    ! Routine entry sequence marker. Determine length
	    ! of routine prolog from effective address in RH
	    !-
	    BEGIN
	    ECNT = .P[M_IMMEDIATE];
	    AOS(0,P);			! Advance to 1st prolog instruction
	    END
	ELSE
	    !+
	    ! No prolog for this routine
	    !-
	    ECNT = 0;

	VTEMP = .P;			! Save pointer in static storage

	UNTIL (ECNT = .ECNT-1) LSS 0 DO
	    BEGIN
	    XCT(0,VTEMP,0,1);	! Execute instruction(s) after DEBUG UUO
	    AOS(0,VTEMP)	!  push RETURN past them
	    END;

	PUSH(SP,VTEMP)		! and SAVE the return address again
	END;

    MACHOP( %O'200', S1036(1,2), SAVE_AC2 );	! MOVE AC2,SAVE_AC2.

    PUSH(SP, FP);		! Enter a FRAME
    FP = .SP;
    RSAVE = .SAVED_AC;		! Restore value we were preserving.
    RETVAL = .RETVAL;		! Continue to tie-up VREG.

    CALLEM();
    POP(SP, FP);                ! Undo the frame and return to caller
    END;

GLOBAL BIND SIXUUO = UUOH;

!   This definition just results in a symbol table entry
!   for "SIXRET".  The value is define dynamically in INITSIX12.
!
GLOBAL BIND SIXRET = -1;
%SBTTL	'Initialization Code - Called from BLISS Main Routine'
ROUTINE INITSIX12: NOVALUE=
    BEGIN
    LOCAL
	T	: SYMBOL;

    SETOFF(COPQFLAG);
    STEPFLAG = TRACEFLAG = LPTFLAG = OPQCNT = 0;
    INSIXHDR = 0;
    SIXHDR = 0;
    SETOFF(DISKIFLAG);
    SETOFF(DISKOFLAG);
    GQUALIFIER = 0;	
    HQUALIFIER = 0;
    HSYM = 0;				! Unknown condition of high symbols
    DEPTH = 0;

    IF .IJOBSYM EQL 0 THEN IJOBSYM = .$JBSYM;

    NROUTS = NVALS = NNAMES = -1;
    DCNT = SIXTOG = BGOBASE;
    GOFLAG = 1;
    SIXREF = 0;
    NEWOPS = -OPSIZE;
    PTEXT = CH$PTR(TEXTAREA);		   ! Reset ptr to MACRO defn area

    IF (T = NSDDTFA(%RAD50_10 'SIXSP', 0)) NEQ 0
    THEN
	T[INVALIDFLAG] = 1;			! Suppress use of this symbol

    ! Set up definition of SIXRET as "JRST @.JBOPC", so that we can easily
    ! return from DDT with the command:
    !			SIXRET$X
    !
    IF (T = NSDDTFA(%RAD50_10 'SIXRET', 0)) NEQ 0
    THEN
	T[VALUEWRD] = JRSTOP^27 OR 1^22 OR $JBOPC;

    T = NSDDTW(%RAD50_10 'SS$UNW',0,.$JBSYM);	! use explicit lowseg or only symbol table
    IF .T NEQ 0 THEN UNWINDVALUE = .T[VALUEWRD];

    WHACKS = 0;
    SETOFF(WHACKING);

    ! Establish an outermost signal handler which will not be cleaned off the
    !  stack.  This is SIX12's "last-chance" handler.
    !
    CALLENABLED(OUTERSIGNAL,EXITHANDLER,OUTERHANDLER,DOTVREG);

%IF TOPS10
%THEN
    ! Now establish the variables we need to check on to see if the
    ! two-symbol-table hack is going to be used

    T = NSDDTW(%RAD50_10 '.JBHGH',0,.$JBSYM);
    IF .T NEQ 0 THEN JOBHGH = .T[ADDRWRD];

    T = NSDDTW(%RAD50_10 '.HIGH.',0,.$JBSYM);
    IF .T NEQ 0 THEN HIGH = .T[ADDRWRD];

    IF .JOBHGH EQL 0 
    THEN
	IJOBHSM = 0
    ELSE
	BEGIN
	T = NSDDTW(%RAD50_10 '.JBHSM',0,.$JBSYM);
	IF .T NEQ 0 
	THEN
	    IJOBHSM = .T[ADDRWRD]
	ELSE
	    IJOBHSM = 6;

	IF .HIGH NEQ 0
	THEN
	    ! We have seen cases where relocating the hiseg on
	    ! TOPS-20 (at least) does not change the value of
	    ! .JBHGH (stupid, but what can you expect from TOPS-20?)
	    ! but in this case, the value .HIGH. is defined
	    IJOBHSM = .IJOBHSM + .HIGH
	ELSE
	    IJOBHSM = .IJOBHSM + .JOBHGH
	END;
%ELSE
    !+
    ! This stuff just doesn't seem to work right at all on the 20, so we
    ! will suppress it.  [It probably can't happen anyway!]
    IJOBHSM = 0;
    HIGH = 0;
    JOBHGH = 0;
%FI
    IF SIXLSF NEQ 0
    THEN
	NOSIXSYMS();	! Kill Local symbols for SIX12 itself
    IOBASE = 8;
    WDBASE = IWDBASE;

    $JB41 = DBG_ON_INST;		! Instruction to execute on DEBUG. UUO
%IF EXTENDED
%THEN
    SWT[$ARNPC,FW] = 1^18 + $JB41;		! Set LUUO trap addr
    SWTRP_( $FHSLF, $SWLUT, 1^18+SWT )		!  and turn on trapper
%FI
    END;
ROUTINE SIXID: NOVALUE=
!+
! FUNCTION
!	Announce what environment we support
!-
    BEGIN
    OUTS('SIX36 ');
    OUTSA(VERSION);
%IF TOPS10
%THEN
    OUTS(' (TOPS-10 I/O) for Bliss-36');
%ELSE
    OUTS(' (TOPS-20 I/O) for Bliss-36');
%FI
    CRLF
    END;
ROUTINE SIX12A(XP)=
!+
! FUNCTION
!	Common initialization code.
! INPUT
!	XP	- Flag indicating type of initialization
!			Bit 35=1	-> Main Program Entry
!			Otherwise	-> User initialization (explicit)
! OUTPUTS
!	?
!-
    BEGIN
    BUILTIN
	FP, SP;
    LOCAL
	SAVE:	VECTOR[4];

    SAVE[0] = .SIXVREG;
    SIXVREG = .VREG;
    SAVE[1] = .RTNLVL;
    SAVE[2] = .ENTERPNT;
    SAVE[3] = .ENTERSP;

    ENTERPNT = .FP;
    ENTERSP = .FP;

    IF .SIXSTK EQL 0 THEN SIXSTK = .SP;

    SELECTONE .XP OF
	SET

      [%O'400000000000']:			! MAIN PROGRAM ENTRY
	    BEGIN
	    INITSIX12();
	    IF .STARTFLAG NEQ 0
	    THEN
		(GOFLAG = 2;  SIXID(); SETINTERNAL())
	    ELSE
		RETURN .SIXVREG
	    END;

      [%O'377777000000']:			! Main program exit (unused?)
	    RETURN .SIXVREG;

      [OTHERWISE]:				! user call
	    BEGIN
	    STOPIT();
	    CRLF;
	    OUTS('Pause ');
	    OUTDEFAULT(.XP);
	    SIXVREG = .ENTERPNT[RET_ADDRESS];

	    IF WITHINSIX12(.SIXVREG)
	    THEN
		OUTS(' from "within SIX12"')
	    ELSE
		(OUTS(' at ');  PRDISP(.SIXVREG));
	    CRLF;
	    SETINTERNAL();
	    SIXVREG = -1
	    END

	TES;

    SIXTOG = .SIXTOG-1;			! to KEEP COUNTERS IN STEP
    B36ISUB();
    RTNLVL = .SAVE[1];
    ENTERPNT = .SAVE[2];
    ENTERSP = .SAVE[3];

    BEGIN
    REGISTER
	VERYTEMP=VREG;

    VERYTEMP = .SAVE[0];
    EXCH(VERYTEMP, SIXVREG);
    EXCH(VERYTEMP, SAVE[0])
    END
    END;
ROUTINE SIXDD2: NOVALUE=
    BEGIN
    LOCAL
	SAVE:	VECTOR[3];

    IF .SIXSTK EQL 0
    THEN
	BEGIN
	TTOUTS('You must initialize SIX12',%CHAR(CR,LF));
	TTOUTS('Use "PUSHJ SIXSP,SIX36',%CHAR(CR,LF))
	END;

    SAVE[0] = .SIXVREG;
    SIXVREG = .VREG;
    SAVE[1] = .RTNLVL;
    SETINTERNAL();
    SAVE[2] = .ENTERPNT;
    ENTERPNT = .FREG;

    STOPIT();
    SIXTOG = .SIXTOG-1;
    B36ISUB();

    SIXVREG = .SAVE[0];
    RTNLVL = .SAVE[1];
    ENTERPNT = .SAVE[2];
    TTOUTS('Return to DDT',%CHAR(CR,LF))
    END;
GLOBAL ROUTINE SIXDDT:NOVALUE=
!+
! FUNCTION
!	Transfer control to DDT from SIX12
!-
    BEGIN
    SIXDD2();
    IF .$JBDDT NEQ 0 THEN JRST(0,.$JBDDT);

%IF TOPS20
%THEN
    JRST(0,%O'770000')			! Always loads at 770000
%FI
    END;
GLOBAL ROUTINE SIX36=
!+
! FUNCTION
!	Initialization entry used for Bliss-36 compiler.
!-
    BEGIN
    SIX12A(1^35)
    END;

ROUTINE ENDSIX12:NOVALUE = 0;	! Last code address in SIX12 (except "SIX12")

GLOBAL ROUTINE SIX12(XP)=
!+
! FUNCTION
!	User-callable entrypoint into SIX12
! INPUT
!	XP	- initialization parameter value, indicating what sort of
!		  entry this is....
!-
    SIX12A( .XP);

END ELUDOM

MODULE BREGHOME(ENTRY(%NAME('.BREG')), NODEBUG)=
BEGIN
GLOBAL
    %NAME('.BREG');		! Compatibility with B10 environment
END ELUDOM