Google
 

Trailing-Edge - PDP-10 Archives - cobol12c - cobddt.mac
There are 20 other files named cobddt.mac in the archive. Click here to see a list.
; UPD ID= 3562 on 6/3/81 at 2:16 PM by NIXON                            
TITLE	COBDDT VERSION 12C
SUBTTL	COBOL DEBUG PACKAGE

	SEARCH COPYRT
	SALL

COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

EDIT==47
VERSION==1203

	.COPYRIGHT		;Put standard copyright statement in REL file
	SALL

	SEARCH	P,COMUNI,FTDEFS

IFN TOPS20,<SEARCH	MONSYM,MACSYM>		;[26]
IFE TOPS20,<SEARCH	UUOSYM,MACTEN>

DEFINE $DIE,<
	JRST	CBDABT
>

IF1,<
	INFIX%			;DEFINE %FILES INDICES

 IFN ANS68,<
	%%DB.==:FIXNUM		;NOT DEFINED IN COBOL-68
	FIXNUM==FIXNUM+1	;MAKE DEFINITION CONSISTENT WITH COBOL-74
	FIXNMA==FIXNUM-1	;DEFINE COBOL-74 V12A VALUE ALSO
>>
PURGE	ANS74,ANS68		;REMOVE DEFINITIONS
SUBTTL	REVISION HISTORY
;COBDDT EDIT HISTORY FOR AUTOPATCH
;
;.BEGINR
;.COMPONENT COBDDT
;.VERSION 12B
;.AUTOPATCH 4
;
;.EDIT	40	TOPS-20 BREAK CHARACTER SET WAS INCORRECT
;		DMN,18-AUG-81,SPR:20-16565
;		A:SRC COBDDT
;
;.EDIT	41	DATA-NAME QUALIFICATION SOMETIMES FAILS
;		DMN,18-AUG-81,SPR:20-16561
;		A:SRC COBDDT
;
;.EDIT	42	FIX SUBSCRIPT HANDLING TO PREVENT WRONG RESULTS WHEN USING COMP
;		AST,02-OCT-81,SPR:20-16377
;		A:SRC COBDDT
;
;.ENDA
;.AUTOPATCH 5
;
;.EDIT	43	FIX DISPLAY OF QUALIFIED FIELD IN REDEFINING TABLE
;		JEH,13-SEP-82,SPR:20-18199
;		A:SRC COBDDT
;
;.ENDA
;.AUTOPATCH 6
;.EDIT	44	FIX HISTORY OUTPUT OF LARGE PROGRAMS ON TOPS-10.
;		DMN,22-FEB-83,SPR:10-33562
;		A:SRC COBDDT
;
;
;.AUTOPATCH 7
;
;.EDIT	45	IMPLEMENT ACCEPT OF FLOATING POINT NUMBERS.
;		DMN,21-APR-83,SPR:10-33718
;		A:SRC COBDDT
;
;.EDIT	46	FIX 'STEP' WHEN 'MODULE' HAS CHANGED SYMBOL
;;		TABLE IN USE
;		JEH,23-JUN-83,SPR:10-33724
;		A:SRC COBDDT
;
;.ENDA
;
;.AUTOPATCH 8
;.ENDA
;.AUTOPATCH 9
;.ENDA
;.AUTOPATCH 10
;.ENDA
;.AUTOPATCH 11
;.EDIT	47	Clean up stack before returning from error routine.
;		BCM,25-Mar-85,SPR:20-20554
;		A:SRC COBDDT
;.ENDA
;.ENDV
;.ENDR
;

;WHO	DATE		COMMENT
;
;***** V12B *****
; EDITS 31-33 NOT REQUIRED AS CODE WAS REWRITTEN.
; EDIT ** ADD SUPPORT FOR COBOL-74 DEBUG MODULE.
;		MAKE COBDDT INDEPENDENT OF COBOL-68 AND COBOL-74.
; EDIT ** CREATED SEPARATE COMMAND SCANNERS FOR TOPS10 AND TOPS20 VERSIONS
;		MAJOR ENHANCEMENTS TO OPERATION OF EACH.
;		MADE TOPS20 VERSION USE COMND JSYS AND BE NATIVIZED.
;		TOTALLY SEPARATE PARSING FROM PROCESSING
;		OF THE COMMANDS.  RESHUFFLED CODE ALL AROUND SO THINGS ARE
;		IN A LOGICAL ORDER.  NEW AC ASSIGNMENTS.
;		IMPLEMENTED "SHOW" COMMAND
; EDIT 30 MAKE "STEP" WORK LIKE $X IN DDT
;		BREAKPOINTS ARE IGNORED WHILE STEP IS IN EFFECT.
; EDIT 27 FIX PROBLEM WITH STEP WHEN BREAKPOINTS ARE CLEARED.
; EDIT 26 FIXED BUG IN 'ACCEPT TALLY'. (DIDN'T WORK)
;		FIXED BUG IN 'BREAK TALLY'. (DID AN ACCEPT!)
;		IMPLEMENTED 'DDT' COMMAND.
;		IMPLEMENTED 'LOCATE' COMMAND.
;		IMPLEMENTED 'STEP' COMMAND.
;		IMPLEMENTED 'GO' COMMAND.
;		IMPLEMENTED 'TRACE BACK' COMMAND.
;		ALLOWED BREAKPOINTS AT SECTION NAMES.
;		ALLOWED MODULES COMPILED WITH /P TO BE LINKED IN.
;		MOVED SOME CODE AROUND SO IT IS A LITTLE MORE UNDERSTANDABLE.
;		SUBSTITUTED MNEMONIC LABELS FOR IMPLEMENTORS'S INITIALS!!!!
; EDIT 25 ADDED BETTER COMMENTS, MINOR BUG FIXES.
;		ADDED REQUIREMENT THAT STOP COMMAND BE TYPED IN FULL.
;		ONLY THE CODE CHANGES ARE IDENTIFIED WITH ;[25] COMMENTS.
; EDIT 24 ADDED "NEXT <INTEGER>" COMMAND.
; EDIT 23 FIX BREAKPOINT INSERTION AFTER .REENTER.
; EDIT 22 FIX "? ITEM TOO LARGE FOR TEMP" ERROR TO DISPLAY CORRECTLY
; EDIT 21 IMPLEMENT REENTER COMMAND
; EDIT 20 ALLOW COBDDT TO UNDERSTAND LOWER CASE.
; EDIT 17 FIX SYMBOL TABLE SEARCH FOR QUALIFIED VARIABLES.
; EDIT 16 FIX MEMORY PROTECTION FAILURE FOR QUALIFIED ITEMS.
; EDITS 14 & 15 INADVERTANTLY FIXED IN V10.
; EDIT 13 FIX SO THAT MODULE COMMAND DOES NOT INTERFERE WITH RUNNING (TRACING)
; EDIT 12 SKIP OVER FOUR START UP INSTRUCTIONS (DBMS) TO AVOID ILL MEM REF.
SUBTTL	Entry and exit documentation for COBDDT.

;COBDDT can be invoked in various ways and at various entry points.
;Some invocations cause an action to take place followed by a return to
;the caller.  Other invocations cause an action to take place followed by
;entry to COBDDT's dialogue mode, in which it converses with the user at the
;terminal.  The user has various options for getting out of dialogue
;mode, and that gives COBDDT various ways of exiting.

ENTRY	CBDDT.	;Initialization code - user prog does JSP 16,CBDDT.
		;goes into dialogue mode.

ENTRY	C.TRCE	;Tracing code - user prog does PUSHJ 17,C.TRCE
		;If REEBRK switch is set, a simulated break is done
		;  and dialogue mode is entered.
		;Issues trace message if tracing is on.
		;Remembers procedure names for possible abort message.
		;Returns with POPJ 17, if not in dialogue mode.

ENTRY	BTRAC.	;Error abort code - entered from LIBOL by JRST BTRAC.
		;prints last seen sect/par names.
		;enters dialogue mode.

ENTRY	TRPD.	;PERFORM push code - entered from prog by PUSHJ 17,TRPD.
		;Remembers current sect/par names before executing PERFORM.
		;returns with POPJ 17,

ENTRY	TRPOP.	;PERFORM pop code - entered from prog by PUSHJ 17,TRPOP
		;Restores saved sect/par names after return from PERFORM range.
		;returns with POPJ 17,

;COBOL user code may not be resident either because it uses
;the COBOL program segmentation feature, or because it was linked
;into overlays.  In either case, breakpoints cannot be set if the
;code is not in memory at the time that the breakpoint is requested.
;LINK overlay code requires various bookkeeping functions so that
;the histogram feature and the breakpoint features will work.

ENTRY	SFOV.	;LINK overlay initialization - entered with PUSHJ 17,SFOV.
		;Does the bookkeeping each time a new LINK overlay is loaded.
		;If the user has turned on the OVERLAY break feature,
		;  dialogue mode is entered.  Otherwise, returns with POPJ.
		;Entered from the PUTF. routine in LIBOL, which is called
		;from the inline code at every ENTRY in a module.

ENTRY	SBPSG.	;Segmentation initialization - entered by PUSHJ 17,SBPSG.
		;Does the bookkeeping for non-resident segments each time
		;  they are loaded.
		;Returns with POPJ 17,

ENTRY	CNTRC.	;CANCEL bookkeeping - entered by PUSHJ 17,CNTRC.
		;When a module is CANCELled, all LINK overlays 'below it',
		;as well as the LINK overlay containing it are 'forgotten'.
		;This code does the necessary bookkeeping.
		;returns with a POPJ 17,

ENTRY	HSRPT.	;HISTORY report check - entered by PUSHJ 17,HSPRT.
		;If a STOP RUN is entered before terminating a histogram,
		;LIBOL guarantees the report is written by entering
		;COBDDT here.
		;returns by POPJ 17,

;The following are locations in COBDDT that are not defined as ENTRYs.

; CBREE.	;REENTER code - entered from monitor on REENTER command.
		;(address is supplied to monitor by COBDDT's init code.)
		;asks the user whether he wants to enter COBDDT, or just
		;take a RERUN dump.  If user indicates he wants to enter
		;COBDDT a switch is set so that a simulated break will
		;occur at the NEXT tracepoint.
		;returns by JRST @.JBOPC or by taking rerun dump (LIBOL).

; BCOM		;break code - entered from user program by the sequence:
		;	JSR	bptabl		;(in user's prog)
		;bptabl:JSA	T2,BCOM		;(in breakpoint table)
		;Prints breakpoint information
		;enters dialogue mode.

; DECOD		;dialogue code - entered by JRST DECOD from all over COBDDT.
		;prompts for COBDDT command,
		;reads and decodes the command, calls for command execution.
		;Stays in a loop until an 'exiting command' is read.
		;Exits by:
		;STOP - goes to LIBOL's STOP RUN code.
		;STEP or PROCEED - returns to the user program in various
		;		ways depending on how COBDDT got entered.
		;		IF entered at C.TRCE, or SFOV.,returns by POPJ.
		;		If entered at CBDDT., returns by JRST @PROGST.
		;		If entered at BCOM, returns by executing the
		;			user instruction at point of break,
		;			then a JRST.
		;GO - JRST to the location named.
SUBTTL	ASSEMBLY PARAMETERS AND DEFINITIONS

IFE TOPS20,<
EXTERNAL .JBREL,.JBSA,.JBDDT	;[26]
>

TXTLEN==^D200		;LENGTH OF A COMMAND LINE

;AC DEFINITIONS

SW=0		;SWITCH REGISTER

T0==0		;USED IN EXTEND INST
T1=1		;TEMP. ACS
T2=2
T3=3
T4=4
T5=5

LIT=6		;STACK POINTER FOR LITERAL POOL
COD=7		;STACK POINTER FOR CODE ROLL
DT=10		;PNTR TO DATAB OR PROTAB

W1=11		;HOLDS XWD IN CODE GENERATION
W2=12		;EXTRA WORD FOR CODE GENERATORS

NM==13		;NMTAB INDEX
CH==14		;MOST RECENTLY RETRIEVED CHARACTER
		;FROM THE COMMAND LINE.
P1=15		;USED BY HISTOGRAM ROUTINES
P2=16		;USED BY HISTOGRAM ROUTINES

AP==16		;USER ARG POINTER
PP=17		;PUSH-DOWN POINTER
;SWITCH DEFINITIONS FOR 'SW'

FASIGN==1B18	;"A" OPERAND IS SIGNED
FBSIGN==1B19	;"B" OPERAND IS SIGNED
FANUM==1B20	;"A" OPERAND IS NUMERIC
FBNUM==1B21	;"B" OPERAND IS NUMERIC


;FLAGS COMMON TO TOPS10 AND TOPS20
PNFLG==1B1	;LOOK FOR PROCEDURE NAME
DNFLG==1B2	;LOOKING FOR DATANAME
PRNMFG==1B3	;GOT PROCEDURE NAME
FLNMOK==1B4	;FILENAMES OK AS SYMBOL NAMES, TOO.
NUIFLG==1B6	;TWO PROPER INITIAL SEGMENTS OF SYMBOLS HAVE BEEN FOUND
CRFLG==1B7	;SAW CRLF AT END OF PARSED DATANAME
MINFLG==1B8	;(TOPS-10 ONLY) SAW MINUS SIGN
FILGVN==1B9	;(TOPS-10 ONLY) SAW A FILESPEC
SAWDOT==1B10	;(TOPS-10 ONLY) SAW A "." IN FILESPEC
SAWPPN==1B11	;(TOPS-10 ONLY) SAW A [PPN] IN FILESPEC
;USEFUL TABLES AND DEFINITIONS FOR CODE GENERATORS

CODE9==1		;PICTURE CODE FOR "9"
CODEM==3		;FOR FLOATING "-"
CODES==10		;FOR INSERTED "-"
CODEP==11		;FOR "."

; THESE CODES ARE BASED UPON USAGE CODE -1
; INDEX IS CHANGED TO COMP-1 AND ITS # IS USED BY EDITED

D6MODE==0		;SIXBIT
D7MODE==1		;ASCII
D9MODE==2		;EBCDIC
DSMODE==2		;HIGHEST DISPLAY MODE
D1MODE==3		;1-WORD DECIMAL
D2MODE==4		;2-WORD DECIMAL
FPMODE==5		;FLOATING POINT
EDMODE==6		;EDITED -USES INDEX SLOT
C3MODE==7		;COMP-3

%US.IN==7		;ACTUAL USAGE CODE FOR INDEX TYPE

CHAC:	POINT 4,CH,12	;AC-FIELD IN "CH"

BYTE.S:	OCT 6		;SIXBIT BYTE SIZE
	OCT 7		;ASCII BYTE SIZE
	OCT 9		;EBCDIC BYTE SIZE

BYTE.W:	OCT 6		;SIXBIT BYTES PER WORD
	OCT 5		;ASCII BYTES PER WORD
	OCT 4		;EBCDIC BYTES PER WORD

;BYTE POINTERS BASED UPON MODE
BYPTRS:	POINT	6,0
	POINT	7,0
	POINT	9,0
	POINT	6,0
	POINT	6,0
	POINT	6,0
	0
	POINT	9,0	;COMP-3

;MULTIPLE-PRECISION ARITHMETIC OP-CODES

EXTERNAL	EDIT.S,EDIT.U
;NOTE COBDDT WILL USE EDIT.S AND EDIT.U EVEN WHEN RUNNING ON A KL-10

EXTERNAL	DSPLY.,ACEPT.,MOVE.,C.D6D7,C.D6D9,C.D7D6,C.D7D9
EXTERNAL	C.D9D6,C.D9D7,PD6.,PD7.,PD9.,PC3.,GD6.,GD7.,GD9.,GC3.
EXTERNAL	FLOT.2,DSP.FP,GETNM.,PPOT4.,ISBPS.
IFE BIS,<
EXTERNAL	MAG.
>

;HISTOGRAM DEFINITIONS:

	EOL==12			;END OF LINE CHARACTER.

	HTTLSZ==^D70			;MAXIMUM SIZE FOR TITLE.
	IFNDEF	HPSPLN,<HPSPLN==^D20>	;MAXIMUM NUMBER OF ENTRY POINTS
					; AND PERFORMS TO KEEP TRACK OF.
;DATAB DEFINITIONS

DTNAM==0		;WORD # OF NAMTAB LINK
DTLKP==1		;WORD # OF LINKAGE PTR
DTSON==2		;WORD # OF FATHER/BROTHER/SON LINKS
DTLVL==3		;WORD # OF WORD CONTAINING THE LEVEL NUMBER
DTFLAG==4		;WORD # OF FLAGS
DTSUBW==6		;WORD # OF SUBSCRIPT INFO
DTBP==^D9		;WORD # OF EDIT MASK

DTOCCL==000004		;OCCURS AT THIS LEVEL
CL.NUM==2		;CLASS NUMERIC

;BYTE POINTERS

DTCLAS:	POINT 2,DTFLAG(DT),1	;CLASS FIELD
DTDPL:	POINT 6,DTFLAG(DT),35	;DECIMAL PLACES FIELD
DTESIZ:	POINT 18,5(DT),17	;EXTERNAL SIZE
DTISIZ:	POINT 18,5(DT),35	;INTERNAL SIZE
DTNOCC:	POINT 15,DTSUBW(DT),14	;NUMBER OF OCCURANCES
DTRESD:	POINT 6,3(DT),11	;RESIDUE FIELD
DTUSAG:	POINT 4,3(DT),17	;USAGE FIELD
DTFAL:	POINT 1,4(T4),8		;[43] FATHER/BROTHER LINK

;BITS SET IN FIFTH WORD OF DATAB ENTRY

;LEFT HALF
	DTNUM==1B0	;NUMERIC
	DTSYNL==1B2	;SYNCHRONIZED LEFT
	DTSYNR==1B3	;SYNCHRONIZED RIGHT
	DTSIGN==1B4	;SIGNED
	DTBWZ==1B5	;BLANK WHEN ZERO
	DTSUBS==1B6	;MUST BE SUBSCRIPTED
	DTEDIT==1B7	;EDITED
	DTLINK==1B8	;FATHER (1) OR BROTHER (0) LINK
	DTDEF==1B9	;DEFINED

;RIGHT HALF
	DTLKS==000100	;LINKAGE SECTION FLAG
	DTPLOC==1B30	;DECIMAL POINT IS TO RIGHT OF WORD
	DTSYLL==1B25	;SYNCS AT LOWER LEVELS


;CODE ROLL ALLOCATIONS

N.TMP==^D100		;MAX TEMP STORAGE
N.COD==^D30		;MAX CODE ROLL SIZE
N.LIT==^D30		;MAX LIT POOL SIZE
;PROTAB ENTRY

;BYTE POINTERS

NMLINK:	POINT	15,(T4),17	;LINK UP TO NAMTAB
SECNAM:	POINT	15,1(T4),17	;LINK UP TO SECTION-NAME

PR.FLG==2	;WORD # OF FLAGS

;BITS SET IN THIRD WORD OF PRTAB ENTRY

	PR%SEC==1B25	;PARAGRAPH-NAME (1) OR SECTION-NAME (0)

PR.LN==3	;LINE NUMBER FOR DEBUGGING IN COBOL-74

;TABLE TYPE PARAMETERS

DTTYPE==100000		;DATAB TYPE
PRTYPE==400000		;PRTAB TYPE
TYPMSK==700000		;MASK FOR TYPE FIELD

;TRACE CODE FLAGS

TC.DB==(1B3)		;DEBUGGING REQUIRED
TC.EP==(1B4)		;EXIT PROGRAM
TC.GB==(1B5)		;GOBACK
TC.PE==(1B7)		;PROGRAM ENTRY
TC.AE==(1B8)		;ALTERNATE ENTRY
;DEFINITION OF FIELDS IN COBDDT'S LINK-10 OVERLAY BLOCKS.

OVLTN==0		;LINK TO NEXT.
OVNAM==1		;SIXBIT MODULE NAME.
OVSMD==2		;FIRST LOCATION IN MODULE (LH)
OVEPA==2		;MAIN ENTRY POINT ADDRESS (RH)
OV%NM==3		;%NM.
OV%DT==4		;%DT.
OV%PR==5		;%PR.
OVSLK==6		;FIRST LOCATION IN THE LINK (LH).
OVLKN==6		;LINK NUMBER (RH).

OVBKSZ==7		;SIZE OF THE BLOCK.


;DEFINITIONS OF FIELDS AND FLAGS IN LINK'S TABLES.

F.LIC==1B0		;LINK IN CORE
F.MDL==1B1		;ROUTINE IN MULTIPLE LINKS.
F.RLC==1B2		;LINK IS RELOCATED.

CS.NUM==2		;LINK NUMBER
CS.PTR==4		;PREVIOUS CONTROL SECTION,,NEXT CONTROL SECTION.
CS.COR==7		;LENGTH OF LINK,,FIRST LOC IN LINK.
CS.EXT==10		;AOBJN PTR TO EXTERNAL TRANSFER TABLES.
CS.INT==11		;AOBJN PTR TO INTERNAL TRANSFER TABLES.

JT.FLG==0		;FLAGS (BITS 0-8)
JT.ADR==0		;ADDRESS IF IN CORE (RH)
JT.CST==1		;ADDRESS OF THIS CONTROL SECTION (RH)
JT.MDL==1		;POINTER TO MULTIPLY DEFINED TABLE.


;FUNCT. FUNCTION CODES
F.GCH==4		;GET CHANNEL NO.
F.RCH==5		;RETURN CHANNEL NO.
F.GOT==6		;GET CORE FROM OTS FREE LIST
F.ROT==7		;RETURN CORE TO OTS FREE LIST
F.PAG==15		;GET CORE AT PAGE BOUNDARY

;MESSAGE TYPED BY COBDDT WHEN STARTING UP
STRTUP==[ASCIZ/
[Starting COBOL DDT]
/]
;SOME USEFUL MACROS:

DEFINE TYPE(MESSAGE)<
 IFE TOPS20,<
	OUTSTR	MESSAGE
 >
 IFN TOPS20,<
	HRROI	T1,MESSAGE
	PSOUT%
 >
>

DEFINE PTYPE(MESSAGE)<
 IFE TOPS20,<
	OUTSTR	MESSAGE
 >
 IFN TOPS20,<
	PUSH	PP,T1
	HRROI	T1,MESSAGE
	PSOUT%
	POP	PP,T1
 >
>

DEFINE JTYPE(MESSAGE)<
 IFE TOPS20,<
	OUTSTR	MESSAGE
 >
 IFN TOPS20,<
	PUSHJ	PP,[PUSH PP,T1
		HRROI	T1,MESSAGE
		PSOUT%
		POP	PP,T1
		POPJ	PP,]
 >
>


DEFINE TYPEAC(ACC)<
 IFE TOPS20,<
    OUTCHR ACC
 >
 IFN TOPS20,<
  IFN T1-ACC,<
	PUSH	PP,T1
	MOVE	T1,ACC
   >
	PBOUT%
   IFN T1-ACC,<
	POP	PP,T1
 >>
>

DEFINE TYPEC(X)<
 IFE TOPS20,<
    OUTCHR [X]
 >
 IFN TOPS20,<
	PUSH	PP,T1
	MOVEI	T1,X
	PBOUT%
	POP	PP,T1
 >
>
DEFINE	JTYPEC(X)<
 IFE TOPS20,<
   OUTCHR [X]
>
 IFN TOPS20,<
	JRST [	PUSH PP,T1
		MOVEI T1,X
		PBOUT%
		POP PP,T1
		JRST .+1]
>
>

DEFINE	WARN%	(X)<
	PTYPE	[ASCIZ	\
%'X'\]
>

DEFINE SAVACS,<
	MOVEM	0,RACS
	MOVE	0,[1,,RACS+1]
	BLT	0,RACS+17
>
DEFINE RSTACS,<
	MOVE	0,[RACS+1,,1]
	BLT	0,17
	MOVE	0,RACS
>


DEFINE HLPTXT(A),<
	MOVEI	T1,[ASCIZ \A\]
	MOVEM	T1,HLPMSG
>
;SUBTTL	IMPURE AREA

INTERNAL PTFLG.

PTFLG.:	BLOCK 1		;NON-ZERO IF WE ARE TRACING
DNRSTT:	BLOCK	1	;Done RESET. if -1
BRKONO:	BLOCK 1		;IF NON ZERO BREAK WHEN WE BRING AN OVERLAY IN.
EBRKOV:	BLOCK	1	;ENTRY POINT ADDRESS OF THE OVERLAY WE ARE
			; BREAKING ON.
SUBSPR:	BLOCK 1		;IF NON ZERO THERE ARE SUBROUTINES PRESENT.
CUREPA:	BLOCK 1		;CURRENT ENTRY POINT'S ADDRESS.
ACTEPA:	BLOCK 1		;[46] ACTUAL CURRENT ENTRY POINT'S ADDRESS
CBLIO.:	BLOCK 1		;ADDRESS OF 'RESET.' ROUTINE
PROGST:	BLOCK 1		;STARTING ADDRESS OF COBOL PROGRAM
NSUBS:	BLOCK 1		;NUMBER OF SUBSCRIPTS TYPED
SUB0.:	BLOCK 3		;PLACE FOR SUBS
SAV.T2:			;PLACE TO SAVE "T2" IN BCOM
SAVDT:	BLOCK 1		;PLACE TO SAVE "DT"
FLGS.:	BLOCK 1		;PLACE TO SAVE PROCESSOR FLAGS
TEMP1:			;TEMP STORAGE FOR BP CODE
EAC:	BLOCK 1		;AC NUMBER FOR ASSEMBLY
TEMP2:			;TEMP STORAGE FOR BP CODE
REMAN:	BLOCK 1		;TEMP STORAGE USED IN SUBSCR CALC
SIGNSW:	Z		;[24]REMEMBERS LEADING SIGN ON INTEGER

BASEA:	BLOCK 1		;ADDR OF "A" OPERAND (RH)
RESA==BASEA		;BYTE RESIDUE FOR "A" (LH)
INCRA:	BLOCK 1		;OFFSET FOR "A"
SIZEA:	BLOCK 1		;SIZE OF "A"
MODEA:	BLOCK 1		;USAGE OF "A"
DPLA:	BLOCK 1		;DECIMAL PLACES IN "A"

BASEB:	BLOCK 1		;ADDR OF "B" OPERAND (RH)
RESB==BASEB		;BYTE RESIDUE FOR "B" (LH)
INCRB:	BLOCK 1		;OFFSET FOR "B"
SIZEB:	BLOCK 1		;SIZE OF "B"
MODEB:	BLOCK 1		;USAGE OF "B"
DPLB:	BLOCK 1		;DECIMAL PLACES IN "B"

BASEX==0		;OFFSET OF BASE
RESX==0			;OFFSET OF RESIDUE
INCRX==1		;OFFSET OF OFFSET
SIZEX==2		;OFFSET OF SIZE
MODEX==3		;OFFSET OF USAGE
DPLX==4			;OFFSET OF DECIMAL PLACES

SAVEA:	BLOCK DPLX+1	;PLACE TO SAVE "A" PARAMETERS
SAVEB:	BLOCK DPLX+1	;PLACE TO SAVE "B" PARAMETERS
SAVMA:	BLOCK 2*DPLX+2	;PLACE TO SAVE PARAMETERS DURING MOVES
SAVMB=SAVMA+DPLX+1

SAVAX==SAVEA+DPLX
SAVBX==SAVEB+DPLX
BASAX==BASEA+DPLX
BASBX==BASEB+DPLX
SVMAX==SAVMA+DPLX
SVMBX==SAVMB+DPLX
;BREAK POINT IMPURE AREA

BCOM2:	BLOCK 1		;USED INDIRECT FOR PROCEED CNTR
BCOM3:	BLOCK 1		;USED INDIRECT FOR SECTION NAME
LEAV1:	XWD Z,LEAV	;USED JRST @ TO DISMISS
LEAV:	Z		;HOLDS USER OR OTHER DISMISS INSTR
	JRST	@BCOM	;IF INSTR HOPS
	AOS	BCOM	;IF INSTR SKIPS
	JRST	@BCOM

CUR.BP:	BLOCK 1		;HOLDS CURRENT BP (0 IF VIRGIN)
LAST.:	BLOCK 1		;HOLDS LAST DATA ITEM IN ACCEPT ETC.
SAVSUB:	BLOCK 4		;HOLDS SUBSCRIPT INFO AS ABOVE

DEFINE BP (D) <
IRP (D),<
BP'D:	Z		; JSR ENTRY FOR BREAKPOINT D
	JSA T2,BCOM	; INVOKE BP LOGIC
B'D'INS:	Z		; ORIGINAL INSTR AT BP D
>>

DEFINE BA (D) <
IRP (D),<
B'D'ADR:	Z	; PNTR TOP PROTAB FOR BP'D
B'D'SEC:	Z	; CURRENT ENTRY POINT ADDRESS (LH) AND
			; SECTION NAME PNTR (RH) FOR BP'D
B'D'CNT:	Z	; PROCEED COUNT FOR BP'D
>>

;BREAK POIN CONSTANTS

LBP==3
LBA==3
NBP==^D20
BP (<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20>)
BPN==.-LBP	;ADDR OF LAST BP ENTRY
PAGE
BA (<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20>)
BNADR==.-LBA

CBPADS:	BLOCK 2		;PNTR TOP PROTAB AND SECTION NAME FOR CURRENT BP.

;CODE GENERATION IMPURE AREAS

	CODFST==.		;FIRST LOC TO CLEAR
CODROL:	BLOCK N.COD		;CODE ROLL
LITROL:	BLOCK N.LIT		;LITERAL POOL
TEMPC:	BLOCK 1			;OFFSET IN TEMP
TEMROL:	BLOCK N.TMP		;TEMP STORAGE
	CODLST==.-1		;LAST LOC TO CLEAR

C74FLG:	Z			;-1 IF COBOL-74 MAIN PROGRAM
IFE TOPS20,<
M7FLG:	BLOCK	1		;-1 IF 7 SERIES MONITOR
DEFPTH:	BLOCK	2		;FIRST PART OF DEFAULT PATH
DEFPPN:	BLOCK	1		;LOGGED IN PPN
DEFSFD:	BLOCK	6		;REST OF DEFAULT PATH
>

REEBRK:	Z			; [21] -1 SAYS BREAK TO C.TRCE
				;USED BY ^C/REENTER AND STEP CODE.
REEFLG:	BLOCK	1		; [21] STACK ADDRESS FOR PROCEED
STPCTR:	BLOCK	1		;[26] NO. OF STEPS TO BYPASS
				;BEFORE NEXT BREAK, WHEN STEPPING.
RRDMP:	BLOCK	1		; [21] SAVE RERUN DUMP REENTER ADDRESS

AC0:	BLOCK	20
PDL.:	BLOCK	1		;PUSH DOWN POINTER
DIED.:	BLOCK	1		;FLAG FOR EX DEATH
L.PARA:	BLOCK	1		;PLACE TO SAVE LAST PARA
L.SECT:	BLOCK	1		;PLACE TO SAVE LAST SECTION

ETYPTS:	BLOCK	1		;POINTER INTO THE TABLE BELOW.
ETYTAB:	BLOCK	^D100		;ADDRESSES OF MAIN ENTRY POINTS FOR ALL MODULES.
NMSVD:	Z			;PLACE TO SAVE THE ADDRESS OF AN ENTRY POINT IN ETYTAB.
OVRLHD:	Z			;POINTER TO LIST OF OVERLAY BLOCKS.
OVLCHS:	Z			;ADDRESS OF CONTROL HEADER SECTION FOR
				; THE ROOT LINK.

;COMMAND SCANNER THINGS
DNAME6:	BLOCK	6		;HOLDS SIXBIT DATANAME READ IN
DNAME7:	BLOCK	7		;HOLDS ASCII DATANAME (TO TYPE OUT)

TXTBUF:	BLOCK	TXTLEN/5+1	;COMMAND LINE
TXTBBP:	BLOCK	1		;CURRENT BP TO TXTBUF
PRSCHR:	BLOCK	1		;FIRST PARSED CHARACTER
PRSBBP:	BLOCK	1		;BP AT START OF A PARSE
ATMBUF:	BLOCK	TXTLEN/5+1	;BUFFER FOR ATOM BUFFER
ILINE:	BLOCK	TXTLEN/5+1	;ITTLIN BUFFER

IFN TOPS20,<
;TEXTI BLOCK FOR READING TTY LINES
TXTIBL:	.RDRTY			;LAST WORD GIVEN
	0			;FLAGS
	.PRIIN,,.PRIOU		;INPUT,,OUTPUT JFNS
	0			;DESTINATION PTR (FILLED IN)
	0			;BYTES AVAILABLE (FILLED IN)
	0			;USE START OF BUFFER AS ABOVE
	0			;CONTROL-R TEXT (FILLED IN)
>;END IFN TOPS20

;THE FOLLOWING THREE ITEMS CONTAIN THE ADDRESSES OF %NM., %DT., %PR.
;  IN THAT ORDER

%NM:	BLOCK	1	;ADDR OF %NM.
%DT:	BLOCK	1	;ADDR OF %DT.
%PR:	BLOCK	1	;ADDR OF %PR.
%DB:	BLOCK	1	;ADDR OF %DB.
COBVR:	BLOCK	1	;COBOL VERSION
COBSW:	BLOCK	1	;COMPILER ASSEMBLY SWITCHES

PNM:	BLOCK	1 	; [13] RUN-TIME NM
PDT:	BLOCK	1 	; [13] RUN-TIME DT
PPR:	BLOCK	1 	; [13] RUN-TIME PR
BNM:	BLOCK	1 	; [13] BREAK NM
BDT:	BLOCK	1 	; [13] BREAK DT
BPR:	BLOCK	1 	; [13] BREAK PR

FUN.C0:	BLOCK	1		;FOR GETTING CORE
FUN.C1:	BLOCK	1
FUN.C2:	BLOCK	1
FUN.CS:	BLOCK	1		;STATUS RETURNED FROM FUNCT.

IFE TOPS20,<
;DO NOT SPLIT THESE WORDS
INPDEV:	BLOCK	1		;INPUT DEVICE
INPFSP:	BLOCK	^D10		;INPUT FILESPEC
;WORDS ARE: 0=NAME, 1=EXT, 3=PPN, 4=1ST SFD, ..10=5TH SFD
>

HSTTTL:	BLOCK	<HTTLSZ+5>/5	;PLACE FOR TITLE.

HFINIT:	Z		;NON ZERO IF AN INITIALIZATION OR BEGIN WAS DONE.
HFGTHR:	Z		;NON ZERO IF WE ARE GATHERING STATISTICS.
HFTBST:	Z		;NON ZERO IF WE HAVE SET UP THE TABLES.
HFGTST:	Z		;-1 ==> SET UP INITIAL ITEMS.

HSTRPN:	Z		;REPORT NUMBER.

HSTACS:	BLOCK	20	;PLACE TO SAVE AC'S.
HSTSJF:	Z		;START OF NEXT HISTOGRAM BLOCK
MYJFF:	Z		;USE AS ".JBFF" FOR OVERLAY BLOCK STORAGE
MYJBRL:	Z		;USE AS ".JBREL" FOR OVERLAY BLOCK STRUCTURE

IFE TOPS20,<
	XWD	-5,0		;ARG BLOCK FOR FUNCT. CALLS.
HSTFFC:	Z	2,HSTFFN
	Z	2,HSTFEC
	Z	2,HSTFST
	Z	2,HSTADR
	Z	2,HSTSIZ
>;END IFE TOPS20

	XWD	-4,0		;ARG BLOCK FOR FUNCT. CALLS.
HSTFFB:	Z	2,HSTFFN
	Z	2,HSTFEC
	Z	2,HSTFST
	Z	2,HSTFCH

HSTFFN:	BLOCK	1		;[44] FUNCTION.
HSTFEC:	BLOCK	1		;[44] ERROR CODE.
HSTFST:	BLOCK	1		;[44] STATUS.
HSTFCH:	BLOCK	1		;[44] CHANNEL.
HSTSIZ:	EXP	0		;REQUIRED SIZE
HSTADR:	EXP	0		;ADDRESS

IFE TOPS20,<
HISOUT:	OUT	.-.,		;OUT UUO
HISGST:	GETSTS	.-.,T2		;GETSTS UUO

HSTFB.:				;HISTOGRAM FILOP. BLOCK
HSTFNC:	BLOCK	1		;FUNCTION CODE
HSTIOS:	EXP	.IOASC		;I/O MODE
HSTDEV:	EXP	0
	XWD	HSTOBF,0	;ADDR. OF BUFFER HEADERS
	XWD	2,0		;NO. OF BUFFERS
	XWD	0,HSTNAM	;ADDR. OF LOOKUP/ENTER BLOCK

HSTOBF:	BLOCK	3

HSTNAM:	BLOCK	1		;FILE NAME
HSTEXT:	BLOCK	1		;EXTENSION
HSTPRT:	BLOCK	1		;PROTECTION CODE
HSTPP:	BLOCK	1		;PPN OR PATH POINTER

HSTPTH:	BLOCK	2
HSTPPN:	BLOCK	1		;PPN
HSTSFD:	BLOCK	5		;SFD
	EXP	0		;MAKE SURE ZERO AT END
>;END IFE TOPS20

IFN TOPS20,<
HSTBUF:	BLOCK	200	;FIXED SIZE BUFFER
>

HCURPS:	Z		;CURRENT PARAGRAPH/SECTION.
HSTCPU:	Z		;HOLDS THE RUNTIME.
HSTELP:	Z		;HOLDS THE ELAPSED TIME.
HPSPDL:	Z		;HOLDS THE PUSH DOWN POINTER.
HPSPLO:	BLOCK	HPSPLN	;PUSHDOWN LIST FOR SAVING OLD PARAGRAPH/SECTION
			; WHEN WE START A PERFORM OR ENTER A SUBROUTINE.

	HOVRHD=.-1	;PLACE TO ACCUMULATE OVERHEAD TIME.
HOVCPU:	Z
HOVELP:	Z

	HUNATD=.-1	;PLACE TO SAVE UNACCOUNTABLE TIME.
HUNCPU:	Z
HUNELP:	Z

HSTPDL:	Z		;PLACE TO SAVE THE PUSHDOWN POINTER.
SVT3:	BLOCK	1	;SAVE T3
SAV16:	BLOCK	1	;16 WHEN OVERLAY HANDLER CALLED
SVMPT:	BLOCK	1	;SAVED MODULE POINTER FOR OVERLAYS
RACS:	BLOCK	^D16	;SAVED ACS FROM USER PROG
HLPMSG:	BLOCK	1	;ADDRESS OF HELP MESSAGE TEXT
PRMTXT==[ASCIZ/COBDDT>/]

IFN TOPS20,<
JSSSV1:	BLOCK 1		;SAVE T1
JSSSV2:	BLOCK 1		;SAVE T2
HSTJFN:	BLOCK 1		;JFN OF HISTORY FILE

CMDBKK:	CM%RAI+NEWPAR		;ADDRESS OF REPARSE ROUTINE
	.PRIIN,,.PRIOU		;INPUT,,OUTPUT JFNS
	-1,,PRMTXT		;CONTROL-R BUFFER (NOTE NEW COBDDT PROMPT!)
	-1,,TXTBUF		;POINTER TO TEXT BUFFER
	-1,,TXTBUF		;POINTER TO CURRENT POSITION
	TXTLEN			;NUMBER OF CHARACTERS IN BUFFER
	0			;NUMBER OF UNPARSED CHARACTERS
	-1,,ATMBUF		;POINTER TO ATOM BUFFER
	TXTLEN			;NUMBER OF CHARACTERS IN BUFFER
	EXP	JFNBLK		;POINTER TO JFN BLOCK
CBTLEN==.-CMDBKK		;# LOCATIONS TO BLT

CMDBLK:	BLOCK	CBTLEN		;COMMAND BLOCK, COPIED FROM ABOVE

JFNBLK:	0			;FLAGS,,GENERATION NUMBER
	.PRIIN,,.PRIOU		;INPUT,,OUTPUT JFNS
	BLOCK 20		;NO DEFAULTS
PRSJFN:	BLOCK	1		;PARSED JFN
>;END IFN TOPS20

DEBUG.::	0
DBITEM:	BLOCK	1		;ADDRESS OF CURRENT DEBUG-ITEM
SUBTTL	START-UP

;HERE IS START ADDR OF COBDDT, FOR USER PROGRAM
;CALLED BY "JSP 16,CBDDT."

	$COPYRIGHT		;Put standard copyright statement into EXE file
CBDDT.:

;;ONCE-ONLY INITIALIZATION

	MOVEM	16,PROGST	; SAVE ADDR OF BEGINNING OF USER PROG
	AOS	PROGST		;SKIP XWD PARAMETER
	HRRZ	16,(16)		;GET ADDR OF MAIN PROGRAM

	PUSHJ	PP,SETETY	;SET UP TABLE OF ENTRY POINT ADDRESSES
	SUBI	NM,ETYTAB	;FORM AN AOBJN TYPE POINTER FOR
	MOVNI	NM,(NM)		; THE TABLE.
	HRLI	NM,ETYTAB
	MOVSM	NM,ETYPTS	;SAVE IT.
	SETZM	SUBSPR		;Assume no subroutines present
	CAME	NM,[XWD ETYTAB,-1] ;Check that.
	SETOM	SUBSPR		;More than 1 module in this program

	MOVEI	16,%NM		;GET ADDRESSES OF %NM, %DT., %PR.
	PUSHJ	PP,GETNM.
	MOVE	T1,%NM		;GET ADDRESS OF %NM
	MOVE	T2,%COBVR-%%NM.(T1)
	MOVEM	T2,COBVR	;COPY VERSION NUMBER
	MOVE	T2,%COBSW-%%NM.(T1)
	MOVEM	T2,COBSW	;COPY COMPILER SWITCHES
	TRNE	T2,1		;COBOL-74?
	SETOM	C74FLG		;YES-SET FLAG
	LDB	T2,[POINT 12,COBVR,17]
	SKIPE	C74FLG		;NO %DB IN COBOL-68
	CAIGE	T2,1202		;OR IN COBOL-74 PRIOR TO 12B
	TDZA	T2,T2
	MOVE	T2,%%DB.-%%NM.(T1)
	MOVEM	T2,%DB		;STORE POINTER TO DEBUG-ITEM
IFE TOPS20,<
	MOVE	T1,[%CNVER]	;CONFIG TABLE
	GETTAB	T1,
	  SETZ	T1,		;MUST BE VERY OLD
	LDB	T1,[POINT 5,T1,23]	;GET MONITOR VERSION #
	CAIN	T1,7		;TEST FOR 7 SERIES
	SETOM	M7FLG		;IT IS, SET FLAG
	SETOM	DEFPTH		;MY JOB,,GET PATH FUNCTION
	MOVE	T1,[11,,DEFPTH]
	PATH.	T1,		;GET DEFAULT PATH
	  SETZM	DEFPPN		;FAILED
>
	MOVEM	PP,PDL.		;WE'LL USE THAT WHEN WE GET CONFUSED
	MOVE	T1,ETYTAB	;FIRST ENTRY POINT IS THE ONE WE START AT
	MOVEM	T1,CUREPA	;"CURRENT ENTRY POINT ADDRESS"
	MOVEM	T1,ACTEPA	;[46] SINCE 'MOD' COMMAND CAN ALTER CUREPA

	SETZM	LAST.		;LAST DATA ITEM FOR "ACCEPT", "DISPLAY", ETC.
	SETZM	CUR.BP		;CURRENT BREAKPOINT (SET TO 0 FOR "VIRGIN")
	SETZM	DIED.		;PROG DIDN'T "DIE" YET
	SETZM	L.SECT		;NO LAST SECTION
	SETZM	PTFLG.		;NOT TRACING
	SETZM	BRKONO		;DON'T BREAK FOR AN OVERLAY
	SETZM	HFINIT		;HISTORY NOT INIT'D OR BEGUN YET
	SETZM	HFGTHR		;NOT GATHERING STATS YET
	SETZM	HFTBST		;HAVEN'T SETUP THE HIST TABLES YET
	SETOM	HFGTST		;-1 TO SAY "SETUP INITIAL ITEMS"

	MOVE	T1,.JBREN##	;GET RERUN DUMP ADDRESS
	MOVEM	T1,RRDMP	;SAVE IT
	MOVEI	T1,CBREE.	; SET NEW REENTER ADDRESS
	MOVEM	T1,.JBREN	; SO ^C REENTER CAN GET YOU TO COBDDT
	MOVE	T1,[XWD B1ADR,B1ADR+1] ;ZERO THE BREAKPOINTS
	SETZM	B1ADR
	BLT	T1,BNADR+LBA-1

;TYPE STARTUP

	SKIPN	DEBUG.		;SKIP IF WE WANT DEBUG MODULE
	 JRST	CBDT1.		;NO
	TYPE	[ASCIZ/
[COBOL-74 Debug module - type P to start program]/]

CBDT1.:	TYPE	STRTUP		;TYPE STARTUP MESSAGE

;PREVENT DOING A START AGAIN, EXCEPT TO GET INTO COBDDT.
	MOVEI	T1,[	SETOM	DIED.
			PTYPE	STRTUP
			JRST	XECUTX]
	HRRM	T1,.JBSA##
	MOVE	T1,@%NM		;ADDR OF %NM
	MOVEM	T1,PNM		;STORE INTO PROCEED
	MOVEM	T1,BNM		;STORE INTO BREAK
	MOVE	T1,@%DT		;ADDR OF %DT
	MOVEM	T1,PDT		;STORE INTO PROCEED
	MOVEM	T1,BDT		;STORE INTO BREAK
	MOVE	T1,@%PR		;ADDR OF %PR
	MOVEM	T1,PPR		;STORE INTO PROCEED
	MOVEM	T1,BPR		;STORE INTO BREAK
	SETOM	DNRSTT		;Set "Done RESET."
IFN TOPS20,<
	MOVE	T1,[CMDBKK,,CMDBLK] ;SETUP COMMAND BLOCK
	BLT	T1,CMDBLK+CBTLEN-1
>
	JRST	XECUTX		;GO TO COMMAND SCANNER
;SET UP TABLE OF MAIN ENTRY POINT ADDRESSES FOR ALL RESIDENT SUBROUTINES.
; ENTER WITH ADDRESS OF MAIN PROGRAM'S ENTRY POINT IN TA.

SETETY:	MOVEI	NM,ETYTAB	;POINT AT THE TABLE.
SETETD:	HRRZ	T1,(16)		;IF THE INSTRUCTION AT THE
	JUMPE	T1,SETETH	; ENTRY POINT ISN'T "SKIPA 0,0",
	SKIPE	OVLCHS		; THE MODULE IS PROBABLY IN A
	POPJ	PP,		; LINK-10 OVERLAY.
	ADDI	16,1		;IF WE ALREADY HAVE THE ADDRESS
	MOVE	T1,JT.FLG(16)	; OF THE CONTROL HEADER SECTION
	TXNE	T1,F.MDL	; FOR THE ROOT SEGMENT, LEAVE.
	HRRZ	16,JT.MDL(16)	;OTHERWISE PICK IT UP.
	HRRZ	16,JT.CST(16)
	MOVEM	16,OVLCHS
	POPJ	PP,
SETETH:	HRRZ	T1,-2(16)	;GET LINK TO MAIN ENTRY POINT.
	TRNE	T1,-1		;WERE WE AT THE MAIN ENTRY POINT?
	HRRZI	16,(T1)		;NO, BUT WE ARE NOW.
	MOVE	T1,1(16)	;GET THE ADDR OF %FILES.
	SKIPGE	%%NM.(T1)	;IF WE HAVE ALREADY DONE THIS
	POPJ	PP,		; MODULE LEAVE.
	CAILE	NM,ETYTAB+^D100	;IF THERE ISN'T ANY MORE ROOM, COMPLAIN.
	JRST	[PTYPE	[ASCIZ	/
?Too many subroutines for COBDDT to cope with. Please combine
some of them so that there are less than 100 modules./]
		$DIE]
	HRROS	%%NM.(T1)	;MARK THIS MODULE AS DONE.
	HRRZM	16,(NM)		;STASH THE ENTRY POINT'S ADDRESS.
	ADDI	NM,1		;MOVE UP TO NEXT LOC IN THE TABLE.
	HLRZ	T1,1(16)	;GET THE ADDRESS OF THE LIST
				; OF PROGRAMS CALLED BY THIS MODULE.
SETETP:	SKIPN	16,(T1)		;DOES THIS MODULE CALL ANYONE?
	POPJ	PP,		;NO, RETURN.
	PUSH	PP,T1		;SAVE POINTER TO LIST.
	PUSHJ	PP,SETETD	;CURSE AND RECURSE.
	POP	PP,T1		;GET THE POINTER BACK.
	AOJA	T1,SETETP	;GO SEE IF THERE ARE MORE.
SUBTTL	REENTER CODE

;HERE IS THE REENTER ADDRESS FOR COBDDT

CBREE.:	SAVACS			;SAVE THE ACS
	HRRZ	T1,.JBOPC	;SEE IF WE ARE A COBDDT COMMAND WAIT
IFN TOPS20,<
	CAIE	T1,COMMND+1	;ARE WE?
>
IFE TOPS20,<
	CAIE	T1,DECOD0	;ARE WE?
>
	SKIPE	DIED.		;OR REENTERING A TERMINATED PROGRAM
	JRST	CBREED		;YES, JUST REENTER COBDDT

CBREEA:	TYPE	[ASCIZ/Do you want to enter COBDDT? (Y or N) /]
	PUSHJ	PP,GYESNO	;GET "YES" OR "NO"
	 JRST	CBREEA		;NEITHER
	 JRST	CBREEC		;"YES"

;"NO" TYPED
	RSTACS			;RESTORE ACS
	JRST	@RRDMP		;ASSUME HE WANTED RERUN DUMP

;"YES" -- HE WANTS TO ENTER COBDDT
CBREEC:	SETZM	STPCTR		;CLEAR STEP COUNTER ON REENTER
	SETOM	REEBRK		;SAY WE WANT TO BREAK ON NEXT ENTER
	RSTACS			;RESTORE ACS
	JRST	@.JBOPC##	;AND CONTINUE AS PLANNED

;JUST REENTER COBDDT
CBREED:	RSTACS			;RESTORE ACS
IFN TOPS20,<
	JRST	ERESET		;GIVE COBDDT PROMPT AGAIN
>
IFE TOPS20,<
	JRST	DECOD		;GIVE COBDDT PROMPT AGAIN
>
SUBTTL	GYESNO ROUTINE

;ROUTINE TO GET "YES" OR "NO" RESPONSE FROM TERMINAL
; RETURNS .+1 IF NEITHER, .+2 IF "YES", .+3 IF "NO"
IFE TOPS20,<
GYESNO:	INCHWL	CH		;GET 1ST CHAR IN LINE
	MOVE	T1,CH
GYSNOC:	CAIE	T1,7		;CHECK FOR EOL CHARACTERS
	CAIN	T1,12
	 JRST	GYNCHK		;WHEN FOUND, CHECK 1ST CHAR ON LINE
	CAIE	T1,13
	CAIN	T1,14
	 JRST	GYNCHK
	CAIN	T1,32
	 JRST	GYNCHK
	INCHWL	T1		;NOT EOL, GET NEXT CHAR ON LINE
	JRST	GYSNOC		;LOOP
>;END IFE TOPS20

IFN TOPS20,<
GYESNO:	PUSHJ	PP,ITTLIN	;GET INPUT LINE FROM TTY
	 JRST	GYESNO		;ERROR, GO GET ANOTHER LINE
	LDB	CH,[POINT 7,ILINE,6] ;GET 1ST CHARACTER OF THE LINE
	JRST	GYNCHK

;TOPS20 ROUTINE TO JUST READ A LINE FROM TTY INTO "ILINE"
ITTLIN:	MOVEI	T1,TXTIBL	;USE TEXTI BLOCK
	MOVE	T2,[POINT 7,ILINE] ;BUFFER POINTER
	MOVEM	T2,.RDDBP(T1)	;STORE IT
	MOVEI	T2,TXTLEN	;SIZE
	MOVEM	T2,.RDDBC(T1)	;STORE THAT
	MOVX	T2,RD%JFN!RD%BEL ;BREAK ON END OF TTY LINE
	MOVEM	T2,.RDFLG(T1)	;STORE FLAGS
	TEXTI%			;DO TEXTI
	 ERJMP	.+2		;RETURN .+1 IF ERROR
	AOS	(PP)		;SKIP RETURN
	POPJ	PP,		;LINE IN "ILINE"
>;END IFN TOPS20

;HERE WITH CH= FIRST CHARACTER IN LINE, WHEN WE HAVE A REAL EOL CHARACTER
GYNCHK:	CAIE	CH,"Y"		;CHECK "Y"
	CAIN	CH,"y"
	 JRST	GYNYES
	CAIE	CH,"N"
	CAIN	CH,"n"
GYNNO:	 AOSA	(PP)		;NO RETURN
	POPJ	PP,		;NEITHER YES OR NO
GYNYES:	AOS	(PP)		;YES RETURN
	POPJ	PP,
SUBTTL	RETURN TO COMMAND SCANNER

IFE TOPS20,<
;RETURN TO COMMAND SCANNER AFTER TYPING A FINAL CRLF
XECUTC:	TYPE	CRLF
;	JRST	XECUTX
>;END IFE TOPS20

IFN TOPS20,<
XECUTC=XECUTX	;TOPS20 COMND JSYS IS SMART ENOUGH TO KNOW IT MUST TYPE
		; A CRLF FIRST, DON'T BOTHER DOING IT SEPARATELY
>

;HERE IS A LOC THAT IS "JRST"'D TO FROM ANYWHERE AT ALL.
; THE PUSHDOWN STACK IS ASSUMED TO HAVE BEEN CLOBBERED
; AND IS RESTORED FROM "PDL."

XECUTX:	SETZB	SW,NSUBS	;CLEAR FLAGS AND INIT PARSE
	MOVE	PP,PDL.		;RESTORE PUSH-DOWN-LIST
	JRST	DECOD		;***PARSE
SUBTTL	TOPS10 COMMAND SCANNER FOR COBDDT
; THE COMMAND LINE IS READ INTO "TXTBUF", THEN PARSED

IFE TOPS20,<
DECOD:	OUTSTR	PRMTXT		;TYPE PROMPT
	SETZM	HLPMSG		;CLEAR ANY HELP TEXT FROM ERROR
	MOVEI	T3,TXTLEN	;GET MAX SIZE OF BUFFER
	MOVE	T2,[POINT 7,TXTBUF]	;POINT TO IT
	MOVEM	T2,TXTBBP	;SET INITIAL BP TO IT
DECOD0:	INCHWL	T1		;GET A CHAR
	CAIE	T1,33		;ALTMODES
	CAIN	T1,175
	 JRST	DECALT		;YES, HANDLE THEM
	CAIN	T1,15		;CR--IGNORE
	 JRST	DECOD0
	CAIE	T1,32		;CONTROL-Z
	CAIN	T1,7		;CONTROL-G
	 JRST	DECALT		;ALTERNATE FORM OF CRLF
	CAIE	T1,13		;VT?
	CAIN	T1,14		;FORM-FEED
	 MOVEI	T1,12		;PRETEND IT'S A LF
	CAIN	T1,12		;GOT A LF NOW?
	 JRST	DECEOL		;YES
	IDPB	T1,T2		;STORE CHAR IN COMMAND LINE
	SOJG	T3,DECOD0	;IF STILL ROOM, GO GET SOME MORE
	TYPE	[ASCIZ/?Command line too long/]
	JRST	XECUTC		;TRY AGAIN

;HERE FOR ALTERNATE FORMS OF CRLF, WHEN THE EOL DOESN'T DO A CRLF
DECALT:	TYPE	CRLF		;ALTMODE--TYPE CRLF
	MOVEI	T1,12		;PRETEND IT'S A LF
;	JRST	DECEOL		;AND GO STORE IT

;HERE WHEN LINE IS DONE
DECEOL:	IDPB	T1,T2		;STORE EOL CHAR
	MOVEI	T1,0		;STORE NULL
	IDPB	T1,T2

;COMMAND LINE IS NOW IN "TXTBUF"

	PUSHJ	PP,GETUCH	;GET FIRST UPPERCASE CHAR
	PUSHJ	PP,NONSP	;GET FIRST NON-SPACE
	CAIN	CH,12		;JUST A CR ON LINE?
	 JRST	XECUTX		;YES, GO TYPE PROMPT AGAIN
	MOVSI	T1,-NMCMDS	;GET -# OF COMMANDS,,ADDR OF TABLE
	HRRI	T1,CMDTBL
	PUSHJ	PP,KEYWRD	;PARSE THE KEYWORD
	 JRST	XECUTX		;UNKNOWN KEYWORD

;KEYWORD MATCHED -- GO DO IT
	JRST	(T2)		;GO DO IT NOW

SUBTTL	TOPS10 COMMANDS


;COMMANDS MUST BE IN ALPHABETICAL ORDER. THEY MAY CONTAIN "-", "A" THRU "Z",
; AND "0" THRU "9"

DEFINE	COMMANDS,<
CMDM	ACCEPT,ACC.
CMDM	BREAK,BRK.
CMDM	CLEAR,CLR.
CMDM	D,DIS.		;ABBREV. FOR "DISPLAY"
CMDM	DDT,GODDT.
CMDM	DISPLAY,DIS.
CMDM	GO,GO%.
CMDM	HELP,HLP.
CMDM	HISTORY,HIS.
CMDM	LOCATE,LOC.
CMDM	MODULE,MOD.
CMDM	NEXT,NEX.
CMDM	OVERLAY,OVR.
CMDM	PROCEED,PRO.
CMDM	S,STP.
CMDM	SHOW,SHO.
CMDM	ST,STP.
CMDM	STEP,STP.
CMDM	STOP,STOP.
CMDM	TRACE,TRC.
CMDM	UNPROTECT,UNPRO.
CMDM	WHERE,WHER.
>

DEFINE CMDM(A,B),<
XWD	[ASCIZ/A/],B
>
CMDTBL:	COMMANDS
	NMCMDS==.-CMDTBL	;# OF COMMANDS
SUBTTL	KEYWORD DISPATCHES FOR TOPS10

;"ACCEPT" COMMAND
ACC.:	PUSHJ	PP,PRSDNM	;PARSE DATANAME
	MOVEI	W1,ACCGEN	;PARSED CORRECTLY, GO HERE
	JRST	CODGNR

;"BREAK" COMMAND
BRK.:	PUSHJ	PP,PRSPNM	;PARSE PROCEDURE NAME
	JUMPN	W2,SETBRK	;A NAME GIVE, GO HERE
NOPNAM:	TYPE	[ASCIZ/?Procedure name must be given
/]
	JRST	XECUTX

;"CLEAR" COMMAND
CLR.:	PUSHJ	PP,PRSPNM	;PARSE PARAGRAPH NAME
	JRST	CLRBRK		;GO HERE

;"DISPLAY" COMMAND
DIS.:	PUSHJ	PP,PRSDNM	;PARSE A DATANAME
	MOVEI	W1,DISPGN	;GET GOOD DISPATCH ADDRESS
	JRST	CODGNR		;GEN CODE THEN DISPATCH

;"DDT" COMMAND
GODDT.:	PUSHJ	PP,CONFRM	;CONFIRM COMMAND
	JRST	GODDT		;GO DO IT

;"HELP" COMMAND
HLP.:	TYPE	[ASCIZ/% Please read COBDDT.HLP
/]
	JRST	XECUTX

;"GO" COMMAND
GO%.:	PUSHJ	PP,PRSPNM	;PARSE A PROCEDURE NAME
	JUMPE	W2,NOPNAM
	JRST	GOXXX		;GO AHEAD

;"HISTORY" COMMAND
HIS.:	PUSHJ	PP,NONSP	;GET 1ST NON-SPACE
	CAIN	CH,12		;CR?
	 JRST	HIS.E1		;YES

HIS.1:	HLPTXT	<History commands are BEGIN, INITIALIZE, REPORT and END>
	MOVE	T1,[-NMHCDS,,HISTAB]
	PUSHJ	PP,KEYWRD	;PARSE THE KEYWORD
	 JRST	XECUTX		;FAILED
	JRST	(T2)		;GO TO ROUTINE

HIS.E1:	TYPE	[ASCIZ/?History commands are BEGIN, INITIALIZE, REPORT and END
/]
	JRST	XECUTX

;HISTORY BEGIN
HIS.1A:	PUSHJ	PP,FILSTT	;GET FILESPEC, TITLE
	PUSHJ	PP,STICKF	;STORE APPROPRIATE THINGS
	JRST	HISBEG		;DO 'HISTORY BEGIN'


;HISTORY END
HIS.2:	PUSHJ	PP,CONFRM	;EOL NEXT
	JRST	HISSTO		;DO IT

;HISTORY INITIALIZE
HIS.3:	PUSHJ	PP,FILSTT	;PARSE [FILESPEC] 'TITLE'
	PUSHJ	PP,STICKF	;STORE APPROPRIATE THINGS
	JRST	HISINI		;GO DO IT


;HISTORY REPORT
HIS.4:	PUSHJ	PP,FILSTT	;PARSE [FILESPEC] 'TITLE'
	PUSHJ	PP,STICKF	;STORE APPROPRIATE THINGS
	JRST	HISREP		;DO IT

HISTAB:	[ASCIZ/BEGIN/],,HIS.1A
	[ASCIZ/END/],,HIS.2
	[ASCIZ/INITIALIZE/],,HIS.3
	[ASCIZ/REPORT/],,HIS.4
NMHCDS==.-HISTAB		;NUMBER OF HISTORY COMMANDS
;ROUTINE TO PARSE [FILESPEC] 'TITLE'
;STORES TITLE IN HSTTTL, FILESPEC IN INPDEV AND INPFSP
FILSTT:	TXZ	SW,FILGVN!SAWDOT!SAWPPN	;CLEAR FILESPEC FLAGS
	SETZM	INPDEV		;CLEAR INPUT FILESPEC STUFF
	MOVE	T1,[INPDEV,,INPFSP]
	BLT	T1,INPFSP+10	;CLEAR ALL WORDS

	CAIN	CH,12		;CRLF NEXT ON LINE?
	 POPJ	PP,		;YES, JUST RETURN

;LOOK FOR BEGINNING QUOTE OF TITLE
	MOVE	T4,TXTBBP
	ILDB	T1,T4
	CAIE	T1," "
	CAIN	T1,11
	 JRST	.-3		;SKIP LEADING BLANKS
	CAIN	T1,"'"		;'TITLE'?
	 JRST	GOTQT		;YES, GO GET IT

;NO TITLE, TRY TO PARSE THE FILESPEC
	TXO	SW,FILGVN	;OBVIOUSLY: A FILESPEC GIVEN
	PUSHJ	PP,PRSSIX	;GET SOMETHING
	JUMPE	T5,NULWD	;NULL WORD, CHECK FOR "["
	CAIN	CH,":"		;COLON TO END DEVICE NAME?
	 JRST	[MOVEM T5,INPDEV ;YES, STORE DEVICE NAME
		JRST SAWDEV]	;GO GET THE REST
	JRST	CHKNAM		;SEE IF A NAME, ETC.

SAWDEV:	PUSHJ	PP,PRSSIX	;GET NAME
	JUMPE	T5,NULWD	;?NULL WORD, GO SEE
CHKNAM:	MOVEM	T5,INPFSP	;STORE NAME
	CAIN	CH,"."		;DOT?
	 JRST	GETEXT		;YES, GO GET EXT
	CAIN	CH,"["		;START OF PPN?
	 JRST	GETPPN		;YES, GO GET THE PPN
	PUSHJ	PP,NONSP	;SPACE COULD BE END OF FILENAME
	CAIN	CH,"'"		;START OF TITLE?
	 JRST	GOTQT		; YES, GO GET IT
	CAIN	CH,12		;EOL?
	 POPJ	PP,		;YES, RETURN
	TYPE	[ASCIZ/?Invalid character in filename: /]
	TYPEAC	CH		;TYPE OFFENDING CHARACTER
	JRST	XECUTC		;TYPE CRLF AND EXIT

;DOT SEEN.. PARSE EXTENSION
GETEXT:	TXO	SW,SAWDOT	;SET FLAG SO WE KNOW HE TYPED ONE
	PUSHJ	PP,PRSSIX	;GET EXTENSION
	JUMPE	T5,NULWD	;NULL WORD
	HLLZM	T5,INPFSP+1	;STORE EXTENSION
	PUSHJ	PP,NONSP	;GET TO 1ST NON-SPACE
	CAIN	CH,"["		;START OF PPN
	 JRST	GETPPN		;YES
	CAIN	CH,12		;EOL?
	 POPJ	PP,		;YES, RETURN NOW
	CAIN	CH,"'"		;START OF TITLE?
	 JRST	GOTQT		;YES

;GIVE ERROR
GARBAG:	PUSH	PP,TXTBBP
	POP	PP,PRSBBP
	MOVEM	CH,PRSCHR
	TYPE	[ASCIZ/?Garbage after filespec/]
	PUSHJ	PP,BUTGOT
	JRST	XECUTX		;ERROR, AND GIVE UP

;NULL WORD
NULWD:	CAIN	CH,"["		;START OF PPN?
	 JRST	GETPPN
	CAIN	CH,12		;EOL?
	 POPJ	PP,		;YES, JUST RETURN
	CAIN	CH,"'"		;START OF TITLE?
	 JRST	GOTQT		;YES
	PUSH	PP,TXTBBP	;COMPLAIN
	POP	PP,PRSBBP
	MOVEM	CH,PRSCHR
	TYPE	[ASCIZ/?Error in filespec/]
	PUSHJ	PP,BUTGOT
	JRST	XECUTX

;[ SEEN TO START PPN
GETPPN:	TXO	SW,SAWPPN	;SET PPN FLAG SO WE CAN DEFAULT CORRECTLY
	PUSHJ	PP,PRSOCT	;GET AN OCTAL NUMBER
	HRLM	T1,INPFSP+3	;STORE PROJ NUMBER
	CAIN	CH,","		;COMMA
	 JRST	GETPRG		;YES
	CAIN	CH,"-"		;[-] MEANS DON'T DEFAULT [PPN]
	JRST	GETEPN		;YES IT IS
	TYPE	[ASCIZ/?Comma expected in PPN/]
	PUSH	PP,TXTBBP
	POP	PP,PRSBBP	;START HERE WITH TYPING OUT THE PROBLEM
	MOVEM	CH,PRSCHR
	PUSHJ	PP,BUTGOT	;TYPE WHAT WE ACTUALLY GOT
	JRST	XECUTX		;TYPE CRLF, THEN LEAVE

GETPRG:	PUSHJ	PP,PRSOCT	;GET PROGRAMMER NUMBER
	HRRM	T1,INPFSP+3	;STORE IT
	CAIN	CH,","		;ANOTHER COMMA
	 JRST	GETSFD		;GET SFD'S
	CAIN	CH,12		;EOL
	 POPJ	PP,		;YES, RETURN
	CAIN	CH,"]"		;END OF PPN
	 JRST	GOTEPN		;YES
	PUSH	PP,TXTBBP
	POP	PP,PRSBBP	;MAKE ERROR ROUTINE POINT TO INVALID TERMINATOR
	MOVEM	CH,PRSCHR
	TYPE	<[ASCIZ/?Expected "]" to end PPN/]>
	PUSHJ	PP,BUTGOT
	JRST	XECUTX		;GIVE UP

;HERE TO PARSE SFD'S
GETSFD:	MOVEI	P1,5		;MAX NUMBER OF SFD'S
	MOVEI	P2,INPFSP+4	;POINTER TO PLACE TO STORE IT
GETNFD:	PUSHJ	PP,PRSSIX	;GET AN SFD NAME
	MOVEM	T5,(P2)		;STORE IT
	AOJ	P2,		;UPDATE POINTER
	CAIN	CH,"]"		;END OF PPN
	 JRST	GOTEPN		;YES
	CAIN	CH,12		;EOL
	 POPJ	PP,		;YES, RETURN
	CAIN	CH,","		;MORE SFD'S?
	 JRST	[SOJG	P1,GETNFD ;YES, GO GET MORE IF WE CAN
		TYPE [ASCIZ/?Too many SFD's specified
/]
		JRST	XECUTX]
	PUSH	PP,TXTBBP
	POP	PP,PRSBBP	;MAKE ERROR ROUTINE POINT TO INVALID TERMINATOR
	MOVEM	CH,PRSCHR
	TYPE	<[ASCIZ/?Expected "," or "]" to end SFD/]>
	PUSHJ	PP,BUTGOT
	JRST	XECUTX		;GIVE UP

;HER TO END [-] CORRECTLY
GETEPN:	TXZ	SW,SAWPPN	;CLEAR FLAG SO WE DON'T DEFAULT
	PUSHJ	PP,GETUCH	;GET "]"

;HERE WHEN GOT A "]" TO END PPN
GOTEPN:	PUSHJ	PP,GETUCH	;NEXT CHAR AFTER PPN
	PUSHJ	PP,NONSP	;FIRST NON-SPACE, PLEASE
	CAIN	CH,12		;JUST A CRLF?
	 POPJ	PP,		;YES, RETURN

;CHECK FOR A "'" TO START TITLE
	CAIE	CH,"'"		;START OF TITLE?
	 JRST	GARBAG		;NO, GARBAGE AFTER FILESPEC

;HERE WHEN SAW LEADING "'" FOR TITLE
GOTQT:	MOVE	T3,[POINT 7,HSTTTL] ;SET UP TO READ TITLE INTO HERE
GOTQT0:	ILDB	CH,TXTBBP	;GET NEXT CHAR
	CAIN	CH,"'"		;ENDING QUOTE
	 JRST	GOTQTE		;YES
	CAIN	CH,12		;OR JUST A CRLF
	 JRST	ENDTTL		;IS END
	IDPB	CH,T3		;STORE CHAR IN TITLE STRING
	JRST	GOTQT0		;LOOP

;GOT ENDING QUOTE FOR TITLE STRING
GOTQTE:	ILDB	CH,TXTBBP
	PUSHJ	PP,NONSP	;GET FIRST NON-SPACE AFTER TITLE ENDING QUOTE
	CAIN	CH,12		;EOL
	 JRST	ENDTTL		;IS OK
	TYPE	[ASCIZ/?Junk after 'TITLE' string/]
	PUSH	PP,TXTBBP
	POP	PP,PRSBBP
	MOVEM	CH,PRSCHR
	PUSHJ	PP,BUTGOT
	SETZ	T1,
	IDPB	T1,T3		;STORE NULL TO END TITLE
	JRST	XECUTX		;BUT DON'T RETURN FROM PARSE CORRECTLY

;GOT CRLF TO END TITLE
ENDTTL:	SETZ	T1,
	IDPB	T1,T3		;STORE NULL TO END TITLE
	POPJ	PP,		;RETURN FROM PARSE

;ROUTINE TO STORE THE INPUT FILESPEC IN THE APPROPRIATE PLACES, AND FILL
; IN DEFAULTS, ETC.
;CALL:
;	FILDEV/	SIXBIT DEVICE NAME  (0 IF NONE SPECIFIED)
;	INPFSP/ FILENAME (0 IF NONE SPECIFIED)
;	    +1/  EXTENSION (0 IF NONE SPECIFIED, OR NULL)
;			NOTE: FLAG "SAWDOT" TELLS YOU WHICH CASE
;	    +2/  NOT USED
;	    +3/  P,PN   (P AND/OR PN MAY BE 0)
;	    +4/  SFD1  (0 FOR NOT SPECIFIED)
;	    +5/  SFD2   (" ")
;	... +10/ SFD5
;RETURNS:
;	.+1  WITH ENTER BLOCKS, ETC, ALL SET UP

STICKF:	TXNN	SW,FILGVN	;WAS FILESPEC GIVEN?
	POPJ	PP,		;NO, RETURN
	SKIPN	T1,INPDEV	;GET DEVICE
	MOVSI	T1,'DSK'	;DEFAULT IS DSK
	MOVEM	T1,HSTDEV	;STORE IN FILOP. BLOCK
	MOVE	T1,INPFSP	;GET FILENAME
	MOVEM	T1,HSTNAM
	SKIPN	T1,INPFSP+1	;GET EXTENSION
	MOVSI	T1,'HIS'	;DEFAULT IT
	MOVEM	T1,HSTEXT
	SETZM	HSTEXT+1	;CLEAR PROTECTION CODE
	SETZM	HSTPP		;AND PATH POINTER
	TXNN	SW,SAWPPN	;DID WE SEE A PPN?
	POPJ	PP,		;NO, DON'T DEFAULT ONE
	MOVE	T1,INPFSP+3	;NO, GET PPN (OR ZERO)
	TLNN	T1,-1		;NEED TO DEFAULT?
	HLL	T1,DEFPPN	;YES
	TRNN	T1,-1		;DEFAULT?
	HRR	T1,DEFPPN
	SKIPE	INPFSP+4	;ANY SFD'S?
	JRST	STCKF1		;YES
	MOVEM	T1,HSTPP
	POPJ	PP,

STCKF1:	MOVEM	T1,HSTPPN
	MOVEI	T1,HSTPTH
	HRRZM	T1,HSTPP	;FORM PATH POINTER
	MOVE	T1,[INPFSP+4,,HSTSFD]
	BLT	T1,HSTSFD+4	;COPY FULL SFD
	POPJ	PP,		;DONE, RETURN

;"LOCATE" COMMAND
LOC.:	PUSHJ	PP,PRSDPN	;PARSE DATANAME OR PROCEDURE NAME
	JRST	LOCTYP		;DO 'LOCATE'

;"MODULE" COMMAND
MOD.:	PUSH	PP,TXTBBP	;CHECK FOR CRLF FOLLOWING THIS
	PUSHJ	PP,NONSP	;(INCASE OF TRAILING SPACES)
	POP	PP,TXTBBP
	CAIN	CH,12		;JUST CRLF?
	 JRST	MODH		;YES, TYPE MODULES IN CORE
	PUSHJ	PP,PRSMOD	;GET SIXBIT WORD INTO T5
	JUMPE	T5,MODNEX	;?MODULE NAME EXPECTED
	JRST	MOD.1		;GO DO IT

MODNEX:	TYPE	[ASCIZ/?Module name expected
/]
	JRST	XECUTX

;"NEXT" COMMAND
;GET OPTIONAL NUMBER AFTER COMMAND (DEFAULT IS 1)
; AND GO TO NEXT1
NEX.:	PUSH	PP,TXTBBP	;CRLF OR NUMBER ALLOWED
	PUSHJ	PP,NONSP	;GET ONE
	POP	PP,TXTBBP
	CAIN	CH,12		;JUST CRLF?
	 JRST	NEXCR		;YES, DEFAULT TO 1
	PUSHJ	PP,PRSDEC	;ELSE GET DECIMAL NUMBER
	JUMPE	T2,DNMEX	;?DECIMAL NUMBER EXPECTED
	MOVE	W2,T2		;SAVE INTEGER (CAN BE NEGATIVE)
	PUSHJ	PP,CONFRM	;CONFIRM
	JRST	NEXT1		;GO DO IT

NEXCR:	MOVEI	W2,1		;DEFAULT TO 1
	JRST	NEXT1

;"OVERLAY" COMMAND
OVR.:	PUSHJ	PP,ONOFF	;GET "ON" OR "OFF"
	 TDZA	W2,W2		;"OFF"
	SETO	W2,		;"ON"
	PUSHJ	PP,CONFRM	;CONFIRM THE COMMAND
	JRST	SETOVR

;"PROCEED" COMMAND
PRO.:	PUSH	PP,TXTBBP	;CHECK FOR CRLF NEXT
	PUSHJ	PP,NONSP
	POP	PP,TXTBBP
	CAIE	CH,12		;CRLF NEXT?
	 JRST	PRO.1		;NO, LOOK FOR NUMBER

	MOVEI	W2,1		;YES, GET VALUE OF 1
	JRST	PROCED		;GO DO IT

PRO.1:	PUSHJ	PP,PRSDEC	;PARSE A DECIMAL NUMBER
	JUMPE	T2,NOTPIN	;"POSITIVE INTEGER REQUIRED"
	JUMPLE	T1,NOTPIN	;NEG OR ZERO IS NO GOOD
	MOVE	W2,T1		;SAVE COUNT IN W2
	PUSHJ	PP,CONFRM	;CONFIRM IT
	JRST	PROCED		;OK, GO TO PROCEED CODE

;GIVE ERROR "POSITIVE INTEGER REQUIRED"
NOTPIN:	TYPE	[ASCIZ/?Positive integer required/]
	PUSHJ	PP,BUTGOT
	JRST	XECUTX

;"SHOW" COMMAND
SHO.:	PUSHJ	PP,NONSP	;GET TO FIRST NON-SPACE
	HLPTXT	<SHOW command syntax is "SHOW SYMBOLS symbol-name-mask">
	CAIN	CH,12		;CR?
	 JRST	[PUSHJ PP,KEWERR ;GIVE KEYWORD ERROR (WILL TYPE HELP MESSAGE)
		JRST XECUTX]	;AND RETURN
	MOVE	T1,[-NMSCDS,,SHOTAB]
	PUSHJ	PP,KEYWRD	;PARSE THE KEYWORD
	 JRST	XECUTX		;FAILED
	JRST	(T2)		;GO TO ROUTINE

SHOTAB:	[ASCIZ/SYMBOLS/],,SHO.S
NMSCDS==.-SHOTAB		;NUMBER OF "SHOW" COMMANDS

;"SHOW SYMBOLS"
SHO.S:	CAIN	CH,12		;CR?
	 JRST	MSKEXP		;YES, SAY MASK MUST BE TYPED
	PUSHJ	PP,PRSMSK	;PARSE SYMBOL MASK
	PUSHJ	PP,CONFRM	;CONFIRM
	JRST	DOSHOS		;GO EXECUTE COMMAND

;"STEP" COMMAND
STP.:	PUSH	PP,TXTBBP
	PUSHJ	PP,NONSP
	POP	PP,TXTBBP
	CAIE	CH,12		;GOT CR NEXT?
	 JRST	STP.1		;NO, LOOK FOR NUMBER

	MOVEI	W2,1		;YES, GET VALUE OF 1
	JRST	STEP

STP.1:	PUSHJ	PP,PRSDEC	;PARSE DECIMAL NUMBER
	JUMPE	T2,NOTPIN	;"POSITIVE INTEGER REQUIRED"
	JUMPLE	T1,NOTPIN
	MOVE	W2,T1		;SAVE COUNT
	PUSHJ	PP,CONFRM	;CONFIRM
	JRST	STEP		;ALL OK, GO TO COMMON CODE

;"STOP" COMMAND
STOP.:	PUSHJ	PP,CONFRM	;CONFIRM IT
	JRST	STOPR		;GO DO IT

;"TRACE" COMMAND
TRC.:	HLPTXT	<ON/OFF/BACK required>
	PUSHJ	PP,NONSP	;GET TO FIRST NON-SPACE.
	MOVE	T1,[-NMTCMS,,TRCCMD]
	PUSHJ	PP,KEYWRD	;LOOK FOR KEYWORD
	 JRST	XECUTX		;CAN'T FIND IT
	PUSH	PP,T2		;SAVE DISPATCH ADDRESS
	PUSHJ	PP,CONFRM	;CONFIRM COMMAND
	POP	PP,T2		;OK, RESTORE DISPATCH ADDRESS
	JRST	(T2)		;FOUND.. DISPATCH

TRCCMD:	[ASCIZ/BACK/],,TRCB
	[ASCIZ/OFF/],,TRCOFF
	[ASCIZ/ON/],,TRCON
NMTCMS==.-TRCCMD		;NUMBER OF 'TRACE' COMMANDS

TRCOFF:	 TDZA	W2,W2		;"OFF"
TRCON:	SETO	W2,		;"ON"
	JRST	TRCONF		;SET TRACE ON/OFF

;"UNPROTECT" HI-SEG COMMAND
UNPRO.:	PUSHJ	PP,CONFRM	;CONFIRM
	JRST	UNPROT		;AND GO DO IT

;"WHERE" COMMAND
WHER.:	PUSHJ	PP,CONFRM	;CONFIRM
	JRST	WHERE		;AND GO DO IT

;SUBTTL	TOPS10 KEYWORD PARSER

;ROUTINE TO PARSE AT KEYWORD. READS AND UPDATES BYTE POINTER TO COMMAND
; LINE (TXTBBP).
;CALL:	T1/ -# OF KEYWORDS IN TABLE,,ADDR OF TABLE
;	CH/ FIRST CHAR OF KEYWORD
;	TABLE FORMAT IS [ASCIZ/KEYWORD/],,ADDR OF ROUTINE TO CALL
;
;RETURNS .+1 IF KEYWORD DOESN'T MATCH, OR IS NOT A UNIQUE ABBREVIATION
;RETURNS .+2 IF KEYWORD DOES MATCH, WITH ADDRESS OF ROUTINE IN T2
;
;UPPER AND LOWERCASE ARE TREATED AS EQUIVALENT
KEYWRD:	MOVEM	CH,PRSCHR	;SAVE 1ST PARSED CHARACTER
	MOVE	T4,[POINT 7,ATMBUF] ;PUT KEYWORD IN ATOM BUFFER FIRST
	PUSH	PP,TXTBBP	;REMEMBER BP AT START OF KEYWORD
	POP	PP,PRSBBP
KEYWR2:	CAIL	CH,"A"
	CAILE	CH,"Z"		;BETWEEN "A" AND "Z"?
	 JRST	NOTLTR		;NO
OKLTR:	IDPB	CH,T4		;OK, STORE CHARACTER
	PUSHJ	PP,GETUCH	;GET NEXT CHARACTER OF KEYWORD
	JRST	KEYWR2		;GO CHECK IT OUT

NOTLTR:	CAIL	CH,"0"
	CAILE	CH,"9"		;ALLOW 0 THRU 9 IN KEYWORD
	 CAIA
	JRST	OKLTR
	CAIN	CH,"-"		;ALLOW DASH IN KEYWORD
	JRST	OKLTR

;HMM THIS CHARACTER IS INVALID.  MUST BE END OF KEYWORD.
;NOW WE TRY TO MATCH IT WITH TABLE ENTRIES.

KEYWD2:	MOVEI	T2,0		;STORE NULL TO END KEYWORD ATOM
	IDPB	T2,T4
	MOVE	T4,[POINT 7,ATMBUF] ;GET POINTER TO ATOM BUFFER
	ILDB	T5,T4		;GET FIRST CHARACTER OF KEYWORD
	JUMPE	T5,[MOVEI T1,[ASCIZ/Keyword expected/]
		JRST KEWERR]

KEYWD3:	HLR	T3,(T1)		;GET PTR TO AN ASCII STRING
	HRLI	T3,(POINT 7,)
	ILDB	T2,T3		;GET FIRST CHAR OF THIS STRING
	CAMN	T2,T5		;DOES IT MATCH SO FAR?
	 JRST	KEYWD4		;YES!
	CAML	T2,T5		;GONE TOO FAR?
	 JRST	NOMTCH		;YES, SAY "NO MATCH"
	AOBJN	T1,KEYWD3	;NO, GET DOWN TO A COMMAND THAT STARTS WITH
				;THIS CHARACTER
NOMTCH:	MOVEI	T1,[ASCIZ/Invalid keyword/] ;DEFAULT MESSAGE
	JRST	KEWERR

;HERE WHEN WE GET A KEYWORD ERROR.. TYPE THE STANDARD MESSAGE
; UNLESS HE HAS SETUP "HLPMSG"
KEWERR:	OUTCHR	["?"]		;START MESSAGE
	SKIPE	HLPMSG		;ANY HELP MESSAGE?
	 JRST [	OUTSTR	@HLPMSG	;YES, PRINT IT
		SETZM	HLPMSG	;CLEAR MESSAGE
		JRST	KEWER1]	;AND GO FINISH MESSAGE
	OUTSTR	(T1)		;PRINT STANDARD MESSAGE
KEWER1:	OUTSTR	CRLF		;CRLF TO END MESSAGE
	SETZM	PRSCHR		;CLEAR 1ST PARSED CHAR
	POPJ	PP,		;ERROR RETURN


;HERE IF FIRST CHARACTER OF KEYWORD MATCHES
KEYWD4:	ILDB	T5,T4		;GET NEXT CHARACTER
	ILDB	T2,T3
	JUMPE	T5,[JUMPE T2,KWDMTC ;GOT A MATCH
		JRST	TRYUNI]	;ELSE TRY FOR A UNIQUE ABBREVIATION
	CAMN	T2,T5		;STILL MATCH?
	 JRST	KEYWD4		;YES, CONTINUE TRYING TO MATCH

;STOPPED MATCHING. LOOK AT NEXT COMMAND FOR POSSIBLE MATCH.
	CAML	T2,T5		;SKIP IF MAYBE NEXT COMMAND IS OK
	 JRST	NOMTCH		;NO, INVALID KEYWORD
	MOVE	T4,[POINT 7,ATMBUF] ;POINT TO ATOM BUFFER AGAIN
	ILDB	T5,T4		;GET 1ST CHAR AGAIN
	AOBJN	T1,KEYWD3	;IF MORE COMMANDS, TRY NEXT ONE
	JRST	NOMTCH		;REACHED END OF TABLE, NO MATCH

;HERE TO TRY FOR A UNIQUE ABBREVIATION
TRYUNI:	AOBJP	T1,OKUNI	;NO MORE COMMANDS = IT MATCHES!
	HLR	T3,(T1)		;POINT TO NEXT COMMAND
	HRLI	T3,(POINT 7,)
	MOVE	T4,[POINT 7,ATMBUF] ;BETTER NOT MATCH TO UNIQUE ABBREV..
TRYUN1:	ILDB	T5,T4		;GET CHAR TYPED
	ILDB	T2,T3		;GET CHAR OF NEXT COMMAND
	CAMN	T5,T2		;SAME SO FAR?
	 JRST	TRYUN1		;YES, KEEP LOOKING
	JUMPN	T5,OKUNI	;IT IS UNIQUE IF REAL CHAR TYPED AND NO MATCH

NOTUNI:	MOVEI	T1,[ASCIZ/Not unique/] ;GET DEFAULT MESSAGE
	JRST	KEWERR		;GO PRINT ERROR

OKUNI:	SUBI	T1,1		;MAKE T1 POINT TO THE COMMAND THAT IS UNIQUE

;HERE WHEN WE GOT A MATCH. RETURN T2=ADDRESS OF ROUTINE TO CALL
KWDMTC:	HRRZ	T2,(T1)		;RH OF TABLE ENTRY = ADDRESS OF ROUTINE
	SETZM	HLPMSG		;CLEAR HELP TEXT IF GIVEN
	SETZM	PRSCHR		;CLEAR 1ST PARSED CHAR
	JRST	CPOPJ1		;GIVE GOOD RETURN
;ROUTINE TO TYPE ", GOT: ", 'REST OF LINE'
; CALL AFTER TYPING "?BLAH EXPECTED"
;RETURNS WITH POPJ

BUTGOT:	TYPE	[ASCIZ/, got: /]
	SKIPE	T1,PRSCHR	;A PARSED CHAR TO TYPE?
	 TYPEAC	T1		;YES
	SETZM	PRSCHR		;CLEAR PARSED CHARACTER
BUTGT1:	ILDB	T1,PRSBBP
	JUMPE	T1,BGERR	;?INTERNAL COBDDT ERROR
	CAIN	T1,12		;EOL
	 JRST	TEOL
	TYPEAC	T1		;TYPE THE CHARACTER
	JRST	BUTGT1		;LOOP

TEOL:	TYPE	[ASCIZ/<EOL>
/]
	POPJ	PP,		;RETURN

BGERR:	TYPE	[ASCIZ/
?Internal COBDDT error - a bug!
/]
	POPJ	PP,
;ROUTINE TO PARSE "ON/OFF"
;DOESN'T RETURN IF NEXT THING IS NOT "ON" OR "OFF"
;RETURNS  .+1 IF "OFF", .+2 IF "ON"

ONOFF:	HLPTXT	<ON/OFF required>
	PUSHJ	PP,NONSP	;GET FIRST NON-SPACE
	MOVE	T1,[-2,,ONOFTB]
	PUSHJ	PP,KEYWRD	;PARSE KEYWORD
	 JRST	XECUTX		;DIDN'T GET EITHER ONE
	JRST	(T2)		;PARSED, GO TO ROUTINE

ONOFTB:	[ASCIZ/OFF/],,CPOPJ
	[ASCIZ/ON/],,CPOPJ1

;ROUTINE TO PARSE "OF/IN"
; THIS IS CALLED FROM THE "PRSNAM" ROUTINE WHEN THERE IS SOMETHING
; ON THE LINE, WHICH CAN ONLY BE "OF" OR "IN"
;RETURNS .+1 IF "OF" OR "IN" PARSED, WITH TXTBBP POINTING TO NEXT CHAR.
;   ELSE GOES TO XECUTX

OFIN:	PUSHJ	PP,NONSP	;GET FIRST NON-BLANK, COULD BE THIS CHAR.
	MOVE	T2,TXTBBP
	MOVEM	T2,PRSBBP	;SAVE START OF THIS THING (?WHATEVER IT IS)
	MOVEM	CH,PRSCHR
	CAIN	CH,"O"		;COULD IT BE "OF"?
	 JRST	OFOF		;YES, TRY IT
	CAIN	CH,"I"		;COULD IT BE "IN"?
	 JRST	OFINN		;YES, TRY IT
NOTOFI:	TYPE	[ASCIZ/?Only "OF" or "IN" legal/]
	PUSHJ	PP,BUTGOT
	JRST	XECUTX		;SCREW THIS PARSE

OFOF:	PUSHJ	PP,GETUCH	;GET NEXT CHAR
	CAIE	CH,"F"
	JRST	NOTOFI

OFININ:	SETZM	PRSCHR		;"OF", "IN" SEEN
	PUSHJ	PP,GETUCH	;GET NEXT CHAR
	PUSH	PP,CH		;SAVE REAL CHAR FOLLOWING OF/IN
	PUSH	PP,TXTBBP	;PEEK AHEAD TO SEE WHAT FOLLOWS
	PUSHJ	PP,NONSP
	POP	PP,TXTBBP
	CAIN	CH,12		;EOL
	 JRST	OFINCR		;BAD
	POP	PP,CH		;RESTORE REAL CHAR FOLLOWING OF/IN
	POPJ	PP,		;RETURN OK

OFINCR:	TYPE	[ASCIZ/?Qualifier expected, got: <EOL>
/]
	SETZM	PRSCHR
	JRST	XECUTX

OFINN:	PUSHJ	PP,GETUCH	;GET NEXT CHAR OF "IN"
	CAIE	CH,"N"
	JRST	NOTOFI		;NOPE
	JRST	OFININ

;ROUTINE TO CONFIRM A COMMAND
; IT POPJ'S IF NEXT THING ON THE LINE IS A CRLF, WHICH CONFIRMS THE
;COMMAND.  IF THE NEXT THING ISN'T A CRLF, IT TYPES AN ERROR MESSAGE
; AND GOES TO XECUTX TO PARSE ANOTHER COMMAND.
CONFRM:	PUSHJ	PP,NONSP	;GET TO FIRST NON-BLANK
	CAIN	CH,12		;CR?
	 POPJ	PP,		;YES, POPJ
NOTCFM:	TYPE	[ASCIZ/?Not confirmed/]
	PUSH	PP,TXTBBP
	POP	PP,PRSBBP
	MOVEM	CH,PRSCHR	;ALSO TYPE THIS CHAR
	PUSHJ	PP,BUTGOT
	JRST	XECUTX

;GET FIRST CHAR WHICH IS A NON-SPACE
NONSP:	CAIE	CH,11
	CAIN	CH,40
	 CAIA
	POPJ	PP,
	PUSHJ	PP,GETUCH	;GET UPPERCASE CHAR
	JRST	NONSP
;ROUTINE TO PARSE A NUMBER
;RETURNS NUMBER PARSED IN T1
;RETURNS NUMBER OF DIGITS IN T2

PRSDEC:	SKIPA	T3,[^D10]	;PARSE A DECIMAL NUMBER
PRSOCT:	MOVEI	T3,^D8		;PARSE AN OCTAL NUMBER
	SETZB	T1,T2		;CLEAR RESULT ,T2=0 MEANS NO NUMBERS SEEN YET
	MOVE	T4,TXTBBP
	MOVEM	T4,PRSBBP
	SETZM	PRSCHR		;CHAR IN CH IS NOT USED
PRSRD1:	ILDB	CH,TXTBBP
	CAIE	CH,11
	CAIN	CH," "
	 JRST	PRSRD1
	CAIN	CH,"-"		;MINUS SIGN
	 JRST	[TXO	SW,MINFLG	;YES, SET FLAG
		ILDB	CH,TXTBBP	;GET NEXT CHAR
		JRST	PRSRD2]		;GO LOOK AT NUMBER
	TXZ	SW,MINFLG	;NO, CLEAR FLAG
PRSRD2:	CAIL	CH,"0"
	CAILE	CH,"0"-1(T3)	;IS NUMBER IN RANGE?
	 JRST	[TXNE	SW,MINFLG	;STOP PARSING, IF NUMBER NEGATIVE?
		MOVN	T1,T1		;YES, NEGATE
		POPJ	PP,]		;RETURN
	IMUL	T1,T3		;MAKE ROOM FOR NEXT DIGIT
	ADDI	T1,-"0"(CH)	;ADD IT IN
	ADDI	T2,1		;COUNT DIGITS SEEN
	ILDB	CH,TXTBBP	;GET NEXT CHARACTER
	JRST	PRSRD2		;AND KEEP GOING...

;ROUTINE TO PARSE A SIXBIT WORD AND RETURN IT IN T5.
;CHAR IN CH IS NOT USED

PRSSIX:	MOVE	T3,[POINT 6,T5] ;GET A BYTE POINTER TO THE WORD.
	SETZ	T5,		;CLEAR IT TO START.
PRSSX1:	PUSHJ	PP,GETUCH	;GET NEXT UPPERCASE CHAR.
	PUSHJ	PP,NONSP	;SKIP LEADING SPACES AND TABS
PRSSX0:	CAIL	CH,"A"		;ALPHANUMERIC ONLY ALLOWED
	CAILE	CH,"Z"
	 JRST	PRSSX2
PRSSXO:	SUBI	CH,40		;CHAR OK, STASH IT
	TLNE	T3,770000	;IF ROOM
	IDPB	CH,T3		;STORE CHAR
	PUSHJ	PP,GETUCH	;GET NEXT CHAR
	JRST	PRSSX0		;GO ADD IT TO STRING
PRSSX2:	CAIL	CH,"0"
	CAILE	CH,"9"		;0 THRU 9 OK
	 POPJ	PP,		;HERE IF NON-SIXBIT CHAR, RETURN
	JRST	PRSSXO		;JUMP -- CHAR OK

;ROUTINE TO PARSE A MODULE WORD AND RETURN IT IN T5.
;CHAR IN CH IS NOT USED
;SAME AS PRSSIX EXCEPT THAT IT ALLOWS "-" IN MODULE NAME.

PRSMOD:	PUSHJ	PP,PRSSIX	;USE COMMON CODE TO PARSE SIXBIT
PRSMD1:	CAIE	CH,"-"		;STOPPED ON HYPHEN?
	POPJ	PP,		;NO, RETURN
	PUSHJ	PP,PRSSXO	;YES, STORE IT
	JRST	PRSMD1		;ALLOW MULTIPLE HYPHENS
;ROUTINE TO PARSE A PROCEDURE NAME
PRSPNM:	TXZ	SW,DNFLG	;DATANAMES NOT ALLOWED
	TXO	SW,PNFLG	;LOOK FOR PROCEDURE NAMES
	JRST	PRSNAM

;ROUTINE TO PARSE A DATANAME
PRSDNM:	TXZ	SW,PNFLG	;PROCEDURE NAMES NOT ALLOWED
	TXO	SW,DNFLG	;LOOK FOR DATANAMES
	JRST	PRSNAM

;ROUTINE TO PARSE A DATANAME OR PROCEDURE NAME
PRSDPN:	TXO	SW,PNFLG!DNFLG	;SET BOTH FLAGS
PRSNAM:	TXZ	SW,PRNMFG	;DIDN'T SEE A PROCEDURE NAME
	SETZM	NSUBS		;CLEAR SUBSCRIPT COUNT
	CAIN	CH,12		;CR NOW?
	 JRST	RETZRO		;YES, RETURN NO SYMBOL

;PEEK AHEAD TO SEE IF NEXT THING WILL BE A <CRLF>
	PUSH	PP,TXTBBP
	PUSHJ	PP,NONSP
	POP	PP,TXTBBP
	CAIN	CH,12
	 JRST	RETZRO		;YES, RETURN 0

PRSNM0:	PUSHJ	PP,PRSCNM	;PARSE A COBOL NAME (RETURNS IF SYNTAX OK)
	SKIPN	C74FLG		;ANS68?
	 TXNN	SW,DNFLG	;AND PARSING A DATANAME?
	  JRST	PRSNTY		;NO
	MOVE	T1,DNAME6	;GET 1ST 6 CHARS
	CAMN	T1,[SIXBIT /TALLY/] ;CHECK FOR "TALLY"
	 JRST	PRSTLY		;GOT IT-- GO FINISH PARSING IT

PRSNTY:	TXZ	SW,FLNMOK	;FILENAMES ARE NOT ALLOWED HERE
	PUSHJ	PP,LOOKNM	;LOOKUP NAME
	 JRST	XECUTX		;ERROR
	JUMPE	DT,UNDEFD	;?NOT FOUND

;IF DATANAME, LOOK FOR SUBSCRIPTS
	PUSHJ	PP,NONSP	;GET TO FIRST NON-SPACE IN ANY CASE.
	TXNN	SW,DNFLG
	 JRST	PRSNM5		;NO SUBSCRIPTS ALLOWED ON PROCEDURE NAMES
	CAIN	CH,12		;IS NEXT THING CRLF?
	 JRST	PRSNM5		;YES, GO TO "SUBSCRIPTS TAKEN CARE OF"
	CAIN	CH,"("		;LPAREN, START OF SUBSCRIPTS?
	 JRST	NXTSBS		;YES, GET "NEXT" SUBSCRIPT

;NOT PAREN.. ONLY "OF/IN" MAY HAPPEN NOW.
	PUSHJ	PP,OFIN
	JRST	PRSNM3		;OK, GO PARSE QUALIFIER

;HERE TO PARSE NEXT SUBSCRIPT
NXTSBS:	PUSHJ	PP,PRSDEC	;GO GET A NUMBER
	JUMPE	T2,DNMEX	;NO DIGITS--?DECIMAL NUMBER EXPECTED
	MOVE	T2,T1		;GET NUMBER PARSED
SUBIOK:	AOS	T1,NSUBS
	CAILE	T1,3		;CHECK MAX ALLOWED
	 JRST	STOOMN		;?TOO MANY SUBSCRIPTS
	MOVEM	T2,SUB0.-1(T1)	;STASH AWAY

;FIND TERMINATOR FOR SUBSCRIPT.
SUBIK1:	CAIE	CH," "		;SPACE?
	CAIN	CH,","		;OR COMMA?
	 JRST	NXTSBS		;YES, GO PARSE MORE SUBSCRIPTS
	CAIN	CH,11
	 JRST	NXTSBS		;TAB, TOO.
	CAIN	CH,")"		;END OF SUBSCRIPTS?
	 JRST	SUBIK3		;YES
	TYPE	[ASCIZ/?Invalid terminator for subscript: /]
	CAIN	CH,12		;CRLF?
	 JRST	SUBIEC		;YES
	TYPEAC	CH
	JRST	XECUTC

SUBIEC:	TYPE	[ASCIZ/<EOL>
/]
	JRST	XECUTX

;HERE IF WE WANTED TO GET A SUBSCRIPT, BUT THE THING WASN'T A DECIMAL NUMBER
DNMEX:	TYPE	[ASCIZ/? Decimal number expected/]
	PUSHJ	PP,BUTGOT
	JRST	XECUTX

;RPAREN AFTER SUBSCRIPT
SUBIK3:	PUSHJ	PP,GETUCH	;GET CHAR AFTER ")"
	PUSHJ	PP,NONSP	;START AT FIRST NON-SPACE

;REVERSE ORDER OF SUBSCRIPTS
	MOVE	T2,NSUBS	;# SUBSCRIPTS SEEN
	MOVE	T1,SUB0.	;GET FIRST SUBSCRIPT
	EXCH	T1,SUB0.-1(T2)	;EXCHANGE WITH LAST SUBSCRIPT
	MOVEM	T1,SUB0.	;STORE LAST AS FIRST
	JRST	PRSNM5		;SUBSCRIPTS TAKEN CARE OF

;HERE IF WE PARSED "OF/IN" AFTER NAME
PRSNM3:	PUSH	PP,[-1]		;SAVE TOP OF STACK
	PUSH	PP,DT		;SAVE FIRST STE
PRSN3A:	PUSHJ	PP,PRSCNM	;PARSE COBOL NAME
	TXO	SW,FLNMOK	;FILENAMES ARE ALLOWED AS QUALIFIERS
	PUSHJ	PP,LOOKNM	;LOOK FOR IT
	 JRST	XECUTX		;CAN'T FIND IT
	JUMPE	DT,UNDEFD	;JUMP IF UNDEFINED
	PUSH	PP,DT		;SAVE PTR ON STACK
	PUSHJ	PP,NONSP	;GET TO FIRST NON-SPACE
	CAIN	CH,12		;CRLF NOW?
	 JRST	PRSN10		;YES, GO DO FINAL LOOKUP
	PUSHJ	PP,OFIN		;MUST BE OF/IN THEN
	JRST	PRSN3A		;LOOP FOR MORE QUALIFIERS

;HERE WHEN SUBSCRIPTS TAKEN CARE OF
PRSNM5:	PUSH	PP,[-1]		;MARK BOTTOM OF STACK
	PUSH	PP,DT		;SAVE STE FOR THIS SYMBOL
	CAIN	CH,12		;SAW <EOL>?
	 JRST	PRSN10		;YES, GO SEARCH FOR THIS

;SAW A NAME, AND HAVE FIRST NON-BLANK AFTER NAME IN CH.
;IT IS NOT A CRLF... IT CAN ONLY LEGALLY BE "OF" OR "IN"
	PUSHJ	PP,OFIN		;GET "OF" OR "IN"
	JRST	PRSN3A		;GO GET QUALIFIER

;HERE TO PARSE "TALLY"
PRSTLY:	PUSHJ	PP,CONFRM	;CONFIRM
	SETOB	DT,W2		;SET -1 FOR "TALLY"
	POPJ	PP,		;AND RETURN

RETZRO:	SETZB	W2,DT		;RETURN NO SYMBOL
	POPJ	PP,

PRSN10:	PUSHJ	PP,QUAL		;SEARCH FOR QUALFIED NAME
	 JRST	XECUTX		;ERROR
PRSN11:	POP	PP,T1		;GET -1
	CAME	T1,[-1]
	JRST	.-2
	MOVE	DT,W2		;COPY TO "DT" ALSO
	POPJ	PP,		;OK, RETURN

UNDEFD:	TYPE	[ASCIZ/?Undefined: /]
	MOVE	T3,[POINT 6,DNAME6]
UNDEF0:	ILDB	T1,T3
	JUMPE	T1,UNDEF1	;DONE TYPING NAME IF WE GOT A SPACE
	ADDI	T1,40
	CAIN	T1,":"		;CONVERT BACK TO DASHES
	 MOVEI	T1,"-"
	CAIN	T1,";"		; and dots.
	 MOVEI	T1,"."
	TYPEAC	T1
	JRST	UNDEF0
UNDEF1:	TYPE	CRLF
	JRST	XECUTX

STOOMN:	TYPE	[ASCIZ/?Too many subscripts
/]
	JRST	XECUTX
;ROUTINE TO PARSE A COBOL NAME, AND PUT IN "DNAME6"
;DOESN'T RETURN IF NAME IS BAD SYNTAX
;LEAVES TXTBBP POINTING TO JUST AFTER THE NAME, AND NAME IN "DNAME6"

PRSCNM:	SETZM	DNAME6		;CLEAR OUT ANY OLD NAME
	MOVE	T1,[DNAME6,,DNAME6+1]
	BLT	T1,DNAME6+5
	MOVE	T4,[POINT 6,DNAME6]
	MOVEI	T5,^D30		;MAX # CHARS WE CAN STORE IN IT
PRSCN1:	PUSHJ	PP,GETUCH	;GET FIRST NON-BLANK CHAR
	CAIE	CH,11
	CAIN	CH," "
	 JRST	PRSCN1
	CAIN	CH,12
	 JRST	SNMEXP		;?SYMBOL NAME EXPECTED
PRSCN2:	CAIL	CH,"A"
	CAILE	CH,"Z"		;A LETTER?
	 JRST	PRSCN3		;NO
;HERE IF CHAR IS OK
PRSCN5:	SOJL	T5,NMTOOL	;?NAME TOO LONG
	SUBI	CH,40		;MAKE SIXBIT
	IDPB	CH,T4		;STORE IN DNAME6
	PUSHJ	PP,GETUCH	;GET ANOTHER CHARACTER
	JRST	PRSCN2		;GO CHECK IT OUT

PRSCN3:	CAIL	CH,"0"
	CAILE	CH,"9"
	 CAIA			;NOT A NUMBER
	JRST	PRSCN5		;CHAR IS OK
	CAIE	CH,"-"		;DASH IS OK
	 JRST	PRSC3A		;Not dash
	MOVEI	CH,":"		;CONVERT TO COLON
	JRST	PRSCN5		;CHAR IS OK
PRSC3A:	CAIE	CH,"."		;DOT IS OK
	 POPJ	PP,		;INVALID CHAR-- RETURN FROM PARSE
	MOVEI	CH,";"		;Convert to semi-colon
	JRST	PRSCN5		;Char is ok.

;NO NAME GIVEN, JUST CRLF
SNMEXP:	TYPE	[ASCIZ/?Symbol name expected, got: <EOL>
/]
	JRST	XECUTX

;NAME IS TOO LONG -- TRUNCATE
NMTOOL:	TYPE	[ASCIZ/% Name too long, truncated: /]
	TYPEAC	CH		;TYPE THIS CHARACTER
TRUNC:	PUSHJ	PP,GETUCH	;NEXT CHAR
	CAIE	CH,11
	CAIN	CH," "
	 JRST	TRUNC1
	CAIN	CH,12
	 JRST	TRUNC1
	TYPEAC	CH
	JRST	TRUNC
TRUNC1:	TYPE	CRLF
	POPJ	PP,
;ROUTINE TO PARSE A SYMBOL TABLE MASK (FOR "SHOW")
; PUTS NAME IN DNAME6
;DOESN'T RETURN IF BAD SYNTAX
;LEAVES TXTBBP POINTING TO JUST AFTER THE MASK, AND MASK IN "DNAME6"

PRSMSK:	SETZM	DNAME6		;CLEAR OUT ANY OLD NAME
	MOVE	T1,[DNAME6,,DNAME6+1]
	BLT	T1,DNAME6+4
	MOVE	T4,[POINT 6,DNAME6]
	MOVEI	T5,^D30		;MAX # CHARS ALLOWED IN MASK
PRSMS1:	PUSHJ	PP,GETUCH	;GET FIRST NON-BLANK CHAR
	CAIE	CH,.CHTAB
	CAIN	CH," "
	 JRST	PRSMS1
	CAIN	CH,12
	 JRST	MSKEXP		;SYMBOL NAME MASK EXPECTED
PRSMS2:	CAIL	CH,"A"
	CAILE	CH,"Z"
	 CAIA			;NOT A LETTER
	 JRST	PRSMS5		;GOOD CHAR
	CAIL	CH,"0"		;A NUMBER?
	CAILE	CH,"9"
	  CAIA			;NO
	 JRST	PRSMS5
	CAIN	CH,"-"		;DASH?
	 JRST	[MOVEI CH,":"	;YES, CONVERT TO COLON
		JRST PRSMS5]
	CAIN	CH,"."		;Dot?
	 JRST	[MOVEI CH,";"	;Yes, convert to semi-colon
		JRST PRSMS5]
	CAIE	CH,"*"		;WILD CHARS OK
	CAIN	CH,"?"
	 JRST	PRSMS5
	CAIN	CH,12
	 POPJ	PP,		;RETURN FROM PARSE
	CAIE	CH,.CHTAB	;IF TABS OR SPACES,
	CAIN	CH," "
	 POPJ	PP,		;RETURN FROM PARSE
	TYPE	[ASCIZ/?Invalid character in symbol name mask: /]
	TYPEAC	CH		;TYPE IT
	JRST	XECUTC		;GIVE UP PARSE

PRSMS5:	SOJL	T5,MSTOOL	;?MASK TOO LONG
	SUBI	CH,40		;MAKE SIXBIT
	IDPB	CH,T4		;STORE IN DNAME6
	PUSHJ	PP,GETUCH	;GET ANOTHER CHARACTER
	JRST	PRSMS2		;GO CHECK IT OUT

MSKEXP:	TYPE	[ASCIZ/?Symbol name mask expected, got: <EOL>
/]
	JRST	XECUTX

;MASK TOO LONG, TRUNCATE
MSTOOL:	TYPE	[ASCIZ/% Symbol name mask too long, truncated: /]
	TYPEAC	CH		;TYPE THIS CHARACTER
	JRST	TRUNC		;TRUNCATE TILL SPACE OR TAB
;ROUTINE TO RETURN NEXT CHARACTER OF COMMAND LINE AND MAKE IT UPPERCASE.

GETUCH:	ILDB	CH,TXTBBP	;GET NEXT CHAR
	CAIL	CH,"A"+40	;CONVERT LOWERCASE
	CAILE	CH,"Z"+40
	 POPJ	PP,
	SUBI	CH,40		;TO UPPERCASE
	POPJ	PP,		;AND RETURN
>;END OF TOPS10 COMMAND SCANNER CODE
SUBTTL	TOPS20 COMMAND SCANNER FOR COBDDT


IFN TOPS20,<
DECOD:	MOVEI	T1,CMDBLK	;POINT TO COMMAND BLOCK
	MOVEI	T2,[FLDDB. (.CMINI)] ;INITIALIZATION FUNCTION
	PUSHJ	PP,COMMND	;GO DO IT

NEWPAR:	MOVE	PP,PDL.		;RESTORE THE STACK
	SKIPN	T1,PRSJFN	;ANY JFN?
	 JRST	NEWPR1		;NO
	RLJFN%			;RELEASE IT
	  TRN
	SETZM	PRSJFN		;CLEAR PARSED JFN
NEWPR1:	MOVEI	T1,CMDBLK	;POINT TO THE COMMAND BLOCK
	MOVEI	T2,[FLDDB. (.CMKEY,,CMDTBL)] ;POINT TO COMMAND TABLE
	PUSHJ	PP,COMMND	;READ THE COMMAND
	MOVE	T3,(T2)		;GET ADDRESS OF ROUTINE
	JRST	(T3)		;DISPATCH

SUBTTL	TOPS20 COMMANDS

;SAME RULES APPLY AS FOR TOPS10 COMMANDS.  THEY ARE SEPARATE
; COMMAND TABLES SO DIFFERENT COMMANDS MAY BE IN TOPS10 AND TOPS20
; VERSIONS  (ALTHOUGH THIS IS NOT RECOMMENDED FOR COMPATIBILITY!)

DEFINE	COMMANDS,<
	CMDM	ACCEPT,ACC.
	CMDM	BREAK,BRK.
	CMDM	CLEAR,CLR.
	CMDM	D,DISABR,CM%ABR+CM%INV
	CMDM	DDT,GODDT.
DISABR: CMDM	DISPLAY,DIS.
	CMDM	GO,GO%.
	CMDM	HISTORY,HIS.
	CMDM	LOCATE,LOC.
	CMDM	MODULE,MOD.
	CMDM	NEXT,NEX.
	CMDM	OVERLAY,OVR.
	CMDM	PROCEED,PRO.
	CMDM	S,STPABR,CM%ABR+CM%INV	;ABBR. FOR "STEP"
	CMDM	SHOW,SHO.
	CMDM	ST,STPABR,CM%ABR+CM%INV ;ABBR. FOR "STEP"
STPABR:	CMDM	STEP,STP.
	CMDM	STOP,STOP.
	CMDM	TRACE,TRC.
	CMDM	WHERE,WHER.
>
DEFINE CMDM(A,B,FLAGS),<
	XWD	[IFNB <FLAGS>,<EXP CM%FW!<FLAGS>>
		ASCIZ/A/],B
>
CMDTBL:	XWD	NMCMDS,NMCMDS
	COMMANDS
	NMCMDS==.-CMDTBL-1
;PARSE "ACCEPT"
ACC.:	PUSHJ	PP,PRSDNM	;PARSE DATANAME
	MOVEI	W1,ACCGEN	;PARSED CORRECTLY, GO HERE
	JRST	CODGNR		;GENERATE CODE AND DO IT

;PARSE "BREAK"
BRK.:	PUSHJ	PP,PRSPNM	;PARSE PROCEDURE NAME
	JUMPN	W2,SETBRK	;A NAME GIVEN, GO HERE
NOPNAM:	TYPE	[ASCIZ/?Procedure name must be given
/]
	JRST	XECUTX


;PARSE "CLEAR"
CLR.:	MOVEI	T2,[ASCIZ/breakpoint at procedure-name/]
	PUSHJ	PP,NOISE
	PUSHJ	PP,PRSPNM	;PARSE PARAGRAPH NAME
	JRST	CLRBRK		;A NAME GIVEN, GO HERE

;PARSE "DISPLAY"
DIS.:	MOVEI	T2,[ASCIZ/dataname/]
	PUSHJ	PP,NOISE
	PUSHJ	PP,PRSDNM	;GO PARSE A DATANAME
	MOVEI	W1,DISPGN	;GET GOOD DISPATCH ADDRESS
	JRST	CODGNR		;GEN CODE THEN DISPATCH

;PARSE "DDT"
GODDT.:	PUSHJ	PP,CONFRM	;GO CONFIRM IT
	JRST	GODDT		;GO DO IT

;PARSE "GO"
GO%.:	MOVEI	T2,[ASCIZ/to procedure-name/]
	PUSHJ	PP,NOISE
	PUSHJ	PP,PRSPNM	;PARSE A PROCEDURE NAME
	JUMPE	W2,NOPNAM	;?PROCEDURE NAME MUST BE GIVEN
	JRST	GOXXX		;DO THE "GO" COMMAND

;PARSE "HISTORY"
HIS.:	MOVEI	T2,[FLDDB. (.CMKEY,,HISTAB)]
	PUSHJ	PP,COMMND	;PARSE THE NEXT WORD
	MOVE	T2,(T2)		;GET ADDRESS OF ROUTINE
	JRST	(T2)		;DISPATCH

;HISTORY BEGIN
HIS.1:	PUSHJ	PP,FILSTT	;PARSE [FILESPEC] 'TITLE'
	PUSHJ	PP,PJFN		;STORE JFN IF ANY
	JRST	HISBEG		;DO 'HISTORY BEGIN'


;HISTORY END
HIS.2:	PUSHJ	PP,CONFRM	;EOL NEXT
	JRST	HISSTO		;DO IT


;HISTORY INITIALIZE
HIS.3:	PUSHJ	PP,FILSTT	;PARSE [FILESPEC] 'TITLE'
	PUSHJ	PP,PJFN		;STORE JFN IF ANY
	JRST	HISINI		;GO DO IT


;HISTORY REPORT
HIS.4:	PUSHJ	PP,FILSTT	;PARSE [FILESPEC] 'TITLE'
	PUSHJ	PP,PJFN		;STORE JFN IF ANY
	JRST	HISREP

HISTAB:	HISLEN,,HISLEN		;HEADER
	[ASCIZ/BEGIN/],,HIS.1
	[ASCIZ/END/],,HIS.2
	[ASCIZ/INITIALIZE/],,HIS.3
	[ASCIZ/REPORT/],,HIS.4
HISLEN==.-HISTAB-1		;NUMBER OF 'HISTORY' COMMANDS
;ROUTINE TO PARSE [FILESPEC] 'TITLE'
; STORES JFN IN PRSJFN, 'TITLE' IN HSTTTL
;RETURNS WITH POPJ, IF ERROR PARSING IT DOESN'T RETURN

FILSTT:	SETZM	PRSJFN		;CLEAR PARSED JFN
	HRROI	T2,[ASCIZ/HIS/]	;DEFAULT EXTENSION
	MOVEM	T2,JFNBLK+.GJEXT
	MOVX	T2,GJ%FOU	;FLAGS
	MOVEM	T2,JFNBLK+.GJGEN
	MOVEI	T2,FLFLTL	;FLDDB'S FOR FILESPEC AND "'"
	PUSHJ	PP,COMMND	;LOOK FOR ONE
	HRRZ	T3,T3		;GET PARSE BLOCK USED
	CAIN	T3,FLFLQT	; WAS IT A QUOTE?
	 JRST	FILST1		;YES, GO GET TITLE
	CAIN	T3,FLNTCM	;JUST <CRLF>?
	 POPJ	PP,		;YES, RETURN
	HRRZM	T2,PRSJFN	;SAVE PARSED JFN
	MOVEI	T2,FLTLEN	;GET 'TITLE' OR END
	PUSHJ	PP,COMMND
	HRRZ	T3,T3		;GET PARSE BLOCK USED
	CAIN	T3,FLNTCM	;NO TITLE, CONFIRMED
	POPJ	PP,		;YES RETURN OK

;GOT FIRST QUOTE FOR TITLE
FILST1:	MOVEI	T2,FLTTL
	PUSHJ	PP,COMMND	;PARSE FIELD TO CRLF
	DMOVE	T1,[POINT 7,HSTTTL  ;TO HERE
		    POINT 7,ATMBUF] ;FROM HERE
	MOVEI	T3,HTTLSZ	;MAX SIZE OF TITLE
FILST2:	SOJL	T3,FILST3	;TRUNCATE
	ILDB	T4,T2		;GET A CHAR
	JUMPE	T4,FILST4	;NULL ENDS STRING
	CAIN	T4,"'"		;SINGLE QUOTE ENDS STRING
	JRST	FILS3A
	IDPB	T4,T1		;STORE THIS CHAR
	JRST	FILST2		;LOOP
FILST3:	PTYPE	[ASCIZ/% Title too long, truncated
/]
FILS3A:	SETZ	T4,		;GET A NULL
FILST4:	IDPB	T4,T1		;STRING ENDS WITH NULL
	POPJ	PP,		;RETURN

FLTTL:	FLDDB. (.CMTXT,CM%SDH,,<TITLE string, ending with "'" or CRLF>)

FLFLTL:	FLDDB.	(.CMFIL,,,,,FLFLQT)
FLFLQT:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,ASCQTE>,<'TITLE'>,,FLNTCM)

FLTLEN:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,ASCQTE>,<'TITLE'>,,FLNTCM)
FLNTCM:	FLDDB.	(.CMCFM)
ASCQTE:	ASCIZ/'/

;ROUTINE TO STORE JFN IN HSTJFN
; IF THERE WAS ONE THERE ALREADY, IT IS RELEASED
PJFN:	SKIPN	T4,PRSJFN	;DID WE PARSE A FILESPEC?
	 POPJ	PP,		;NO, RETURN
	SETZM	PRSJFN		;CLEAR PARSED JFN SO IT DOESN'T GET RELEASED
	SKIPN	T1,HSTJFN	;YES, DID WE ALREADY DO THAT BEFORE?
	 JRST	PJFN1		;NO
	RLJFN%			;YES, RELEASE IT
	  ERJMP	.+1		;IGNORE ERROR
PJFN1:	MOVEM	T4,HSTJFN	;STORE NEW JFN
	POPJ	PP,		;AND RETURN

;PARSE "LOCATE"
LOC.:	PUSHJ	PP,PRSDPN	;PARSE DATANAME OR PROCEDURE NAME
	JRST	LOCTYP		;DO 'LOCATE'

;PARSE "MODULE"
MOD.:	MOVEI	T2,FLMODC
	PUSHJ	PP,COMMND	;PARSE <CRLF> OR NAME
	HRRZ	T3,T3		;GET PARSE BLOCK USED
	CAIN	T3,FLMODC	;CRLF?
	 JRST	MODH		;GO TYPE MODULES IN CORE & POPJ
				;PARSE AN ARBITRARY FIELD
	PUSHJ	PP,CONFRM	;CONFIRM IT
	SETZ	T5,		;PUT NAME INTO T5
	DMOVE	T1,[POINT 7,ATMBUF
		POINT 6,T5]	;PUT NAME IN T5
MOD.0:	ILDB	T3,T1		;GET A CHAR
	JUMPE	T3,MOD.1	;GOT MODULE NAME
	CAIL	T3,"A"+40
	CAILE	T3,"Z"+40
	 CAIA
	SUBI	T3,40		;MAKE UPPERCASE
	SUBI	T3,40		;MAKE SIXBIT
	CAIL	T3,0
	CAILE	T3,77		;LEGAL SIXBIT?
	 JRST	MOD.3		;NO, COMPLAIN
	TLNE	T2,770000	;IF THERE'S ANY ROOM
	IDPB	T3,T2		;STORE CHARACTER
	JRST	MOD.0		;LOOP

;HERE IF BAD CHAR IN MODULE NAME
MOD.3:	ADDI	T3,40		;GET CHAR THAT FAILED
	HRROI	T1,[ASCIZ/?Not a legal sixbit character: /]
	PSOUT%
	HRRZ	T1,T3
	PBOUT%
	HRROI	T1,[ASCIZ/
/]
	PSOUT%
	JRST	ERESET		;FINISH ERROR


FLMODC:	FLDDB.	(.CMCFM,CM%SDH,,<CRLF to list modules in core>,,FLMODU)
FLMODU:	FLDDB. (.CMFLD,CM%SDH,,<Sixbit name of module>)

;PARSE "NEXT"
NEX.:	MOVEI	T2,FLNEX
	PUSHJ	PP,COMMND	;PARSE ARG TO "NEXT"
	HRRZ	T3,T3		;WHICH PARSE BLOCK USED?
	CAIN	T3,FLNEX1	;<CR>?
	 JRST	NEX1		;YES
	MOVE	W2,T2		;SAVE INTEGER
	PUSHJ	PP,CONFRM	;CONFIRM IT
	JRST	NEXT1		;GO WHEN PARSED

NEX1:	MOVEI	W2,1		;GET DEFAULT VALUE IF BLANK TYPED
	JRST	NEXT1		;GO DO 'NEXT'

FLNEX:	FLDDB.	(.CMNUM,,^D10,,,FLNEX1)
FLNEX1:	FLDDB.	(.CMCFM,CM%SDH,0,<<CRLF> for 1>)
;PARSE "OVERLAY"
OVR.:	MOVEI	T2,[ASCIZ/break mode is/]
	PUSHJ	PP,NOISE
	MOVEI	T2,[FLDDB. (.CMKEY,,OVLYTB)]
	PUSHJ	PP,COMMND	;PARSE ON/OFF
	MOVE	T2,(T2)
	JRST	(T2)

OVR.2:	TDZA	W2,W2		;OFF
OVR.1:	SETO	W2,		;ON
	PUSHJ	PP,CONFRM	;CONFIRM "ON" OR "OFF"
	JRST	SETOVR		;SET "ON" OR "OFF"

OVLYTB:	OVLYLN,,OVLYLN		;HEADER
	[ASCIZ/OFF/],,OVR.2
	[ASCIZ/ON/],,OVR.1
OVLYLN==.-OVLYTB-1		;NUMBER OF 'OVERLAY' COMMANDS
;PARSE "PROCEED"
PRO.:	MOVEI	T2,PROFL
	PUSHJ	PP,COMMND	;PARSE THE THING
	HRRZ	T3,T3		;WHICH PARSE BLOCK WAS USED?
	CAIN	T3,PROFL1	;BLANK?
	 JRST	PRO1		;YES
	MOVE	W2,T2		;SAVE THE #
	PUSHJ	PP,CONFRM	;MUST HAVE BEEN AN INTEGER THEN
	JUMPG	W2,PROCED	;JUMP IF INTEGER IS OK
POSIRQ:	TYPE	[ASCIZ/? Number must be a positive integer
/]
	JRST	XECUTX		;FAIL TO PARSE

;PROCEED <BLANK>
PRO1:	MOVEI	W2,1		;PROCEED COUNT OF 1
	JRST	PROCED		;GO HERE

PROFL:	FLDDB.	(.CMNUM,CM%SDH,^D10,<Decimal number>,,PROFL1)
PROFL1:	FLDDB.	(.CMCFM,CM%SDH,0,<CRLF to proceed to next breakpoint>)

;PARSE "SHOW"
SHO.:	MOVEI	T2,[FLDDB. (.CMKEY,CM%SDH,SHOTAB,<SYMBOLS>)]
	PUSHJ	PP,COMMND
	MOVE	T2,(T2)		;GET ADDRESS OF ROUTINE
	JRST	(T2)		;DISPATCH

SHOTAB:	SHOLEN,,SHOLEN		;HEADER
	[ASCIZ/SYMBOLS/],,SHO.S
SHOLEN==.-SHOTAB-1		;NUMBER OF "SHOW" COMMANDS

;SHOW SYMBOLS
SHO.S:	MOVEI	T2,[ASCIZ/that match the mask/]
	PUSHJ	PP,NOISE
	MOVEI	T2,[FLDDB. (.CMTXT,CM%SDH,,<Symbol name mask>)]
	PUSHJ	PP,COMMND
	LDB	T1,[POINT 7,ATMBUF,6] ;SEE IF ANYTHING TYPED
	JUMPE	T1,SHOER1	;?SYMBOL NAME MUST BE GIVEN
	SETZM	DNAME6		;CLEAR IT OUT
	MOVE	T2,[DNAME6,,DNAME6+1]
	BLT	T2,DNAME6+4
	MOVE	T2,[POINT 6,DNAME6] ;COPY MASK TO HERE
	MOVE	T3,[POINT 7,ATMBUF,6] ;FROM HERE
SHOC0:	CAIE	T1,.CHTAB		;SKIP LEADING BLANKS, TABS
	CAIN	T1," "
	 JRST	[ILDB T1,T3
		JRST SHOC0]
	MOVEI	T4,^D30		;MAX # CHARS WE CAN TRANSFER
SHOC1:	CAIL	T1,"A"+40
	CAILE	T1,"Z"+40	;CONVERT TO UPPER CASE
	 CAIA
	SUBI	T1,40
	CAIL	T1,"A"
	CAILE	T1,"Z"		;A-Z IS OK
	 CAIA
	JRST	SHOC2
	CAIL	T1,"0"		;0-9 IS OK
	CAILE	T1,"9"
	 CAIA
	JRST	SHOC2
	CAIN	T1,"-"		;DASH IS OK
	 JRST	[MOVEI T1,":"	;CONVERT IT TO COLON
		JRST SHOC2]
	CAIN	T1,"."		;Dot is ok
	 JRST	[MOVEI T1,";"	;Convert it to semicolon
		JRST SHOC2]
	CAIN	T1,"%"		;WILD CHAR IS OK
	 JRST	[MOVEI T1,"?"	;CONVERT TO "?"
		JRST	SHOC2]
	CAIN	T1,"*"
	 JRST	SHOC2
	JUMPE	T1,SHOC3	;NULL ENDS STRING, IS OK
	CAIE	T1,.CHTAB	;TABS OR SPACES?
	CAIN	T1," "
	 JRST	SHOER2		;YES, COMPLAIN
	TYPE	[ASCIZ/?Invalid character in symbol name mask: /]
	LDB	T1,T3		;RE-FETCH CHARACTER
	TYPEAC	T1		;TYPE IT
	JRST	XECUTX		;FORGET COMMAND

SHOC2:	SOJL	T4,SHTOLN	;JUMP IF MASK WAS TOO LONG
	SUBI	T1,40		;MAKE SIXBIT CHARACTER
	IDPB	T1,T2		;STORE
	ILDB	T1,T3		;GET NEXT CHARACTER
	JRST	SHOC1		;LOOP FOR ALL OF EM

SHOC3:	JRST	DOSHOS		;GO DO IT
SHOER1:	TYPE	[ASCIZ/?Symbol name mask must be given
/]
	JRST	XECUTX

SHOER2:	ILDB	T1,T3		;TRAILING BLANKS ARE OK, IF NOTHING ELSE
	CAIE	T1,.CHTAB
	CAIN	T1," "
	 JRST	SHOER2
	JUMPE	T1,SHOC3	;DONE
	PUSH	PP,T1		;SAVE CHAR
	TYPE	[ASCIZ/?Junk following symbol name mask: /]
	POP	PP,T1		;TYPE FIRST CHAR OF JUNK
	TYPEAC	T1
	MOVE	T1,T3		;GET BP TO REST OF FIELD
	PSOUT%			;TYPE IT
	JRST	XECUTX		;RETURN

SHTOLN:	TYPE	[ASCIZ/?Symbol name mask too long
/]
	JRST	XECUTX
;PARSE "STEP"
STP.:	MOVEI	T2,STPFL
	PUSHJ	PP,COMMND	;PARSE NUMBER OR CRLF
	HRRZ	T3,T3		;GET WHICH PARSE BLOCK USED
	CAIN	T3,STPFL1	;CRLF?
	 JRST	STP1		;YES
	MOVE	W2,T2		;SAVE NUMBER
	MOVEI	T2,[FLDDB. (.CMCFM)] ;CRLF TO CONFIRM
	PUSHJ	PP,CONFRM
	JUMPLE	W2,POSIRQ	;COMPLAIN IF NEG OR ZERO
	JRST	STEP		;GOOD NUMBER--GO DO IT

STP1:	MOVEI	W2,1		;STEP COUNT OF 1
	JRST	STEP		;GO HERE

STPFL:	FLDDB.	(.CMNUM,CM%SDH,^D10,<Decimal number>,,STPFL1)
STPFL1:	FLDDB.	(.CMCFM,CM%SDH,0,<CRLF to proceed to next paragraph>)

NOTPIN:	TYPE	[ASCIZ/?Number must be a positive integer
/]
	JRST	XECUTX


;PARSE "STOP"
STOP.:	MOVEI	T2,[ASCIZ/the program and exit to monitor/]
	PUSHJ	PP,NOISE	;EXPLAIN WHAT THIS COMMAND DOES
	PUSHJ	PP,CONFRM	;CONFIRM "STOP"
	JRST	STOPR

;PARSE "TRACE"
TRC.:	MOVEI	T2,[FLDDB. (.CMKEY,,TRCTAB)]
	PUSHJ	PP,COMMND	;GET ARGUMENT FOR TRACE
	MOVE	T2,(T2)		;GET WHICH ONE
	JRST	(T2)		;GO TO ON/OFF ROUTINE

TRC.2:	TDZA	W2,W2		;TRACE OFF
TRC.1:	SETO	W2,		;TRACE ON
	PUSHJ	PP,CONFRM	;CONFIRM 'TRACE' COMMAND
	JRST	TRCONF		;SAVE ON/OFF VALUE

;"TRACE BACK"
TRC.B:	PUSHJ	PP,CONFRM	;CONFIRM "TRACE BACK"
	JRST	TRCB		;GO DO IT

TRCTAB:	TRCNUM,,TRCNUM		;HEADER
	[ASCIZ/BACK/],,TRC.B
	[ASCIZ/OFF/],,TRC.2
	[ASCIZ/ON/],,TRC.1
TRCNUM==.-TRCTAB-1		;NUMBER OF "TRACE" COMMANDS


;PARSE "WHERE"
WHER.:	MOVEI	T2,[ASCIZ/are the breakpoints/]
	PUSHJ	PP,NOISE
	PUSHJ	PP,CONFRM	;GO CONFIRM IT
	JRST	WHERE		;DISPATCH TO COMMON CODE

;ROUTINE TO PARSE A PROCEDURE NAME
PRSPNM:	TXZ	SW,DNFLG	;DATANAMES NOT ALLOWED
	TXO	SW,PNFLG	;LOOK FOR PROCEDURE NAMES
	JRST	PRSNAM

;ROUTINE TO PARSE A DATANAME
PRSDNM:	TXZ	SW,PNFLG	;PROCEDURE NAMES NOT ALLOWED
	TXO	SW,DNFLG	;LOOK FOR DATANAMES
	JRST	PRSNAM

;ROUTINE TO PARSE A DATANAME OR PROCEDURE NAME
PRSDPN:	TXO	SW,PNFLG!DNFLG	;SET BOTH FLAGS
PRSNAM:	TXZ	SW,PRNMFG!CRFLG	;DIDN'T SEE A PROCEDURE NAME OR A CRLF YET (CHECKED AT PRSNM5)
	SETZM	NSUBS		;CLEAR SUBSCRIPT COUNT
	MOVEI	T2,FLSYML	;SYMBOL NAME OR CRLF
	TXNN	SW,DNFLG	;SKIP IF DATANAMES ARE ALLOWED
	MOVEI	T2,FLPRN	;NO, JUST ASK FOR PROCEDURE NAMES
	PUSHJ	PP,COMMND
	TXNN	SW,DNFLG	;SKIP IF DATANAMES ALLOWED
	 JRST	[LDB	T1,[POINT 7,ATMBUF,6] ;SEE IF SOMETHING THERE
		JUMPN	T1,PRSNM0	;YES
		PUSHJ	PP,CONFRM	;NO, THEN CONFIRM NO SYMBOL
		JRST	RETZRO]		;AND RETURN 0
	HRRZ	T3,T3		;WHICH PARSE BLOCK WAS USED?
	CAIN	T3,FLSYML	;CRLF?
	 JRST	RETZRO		;YES, RETURN NO SYMBOL

PRSNM0:	PUSHJ	PP,COPDN6	;COPY NAME TO DNAME6
	SKIPN	C74FLG		;ANS68?
	 TXNN	SW,DNFLG	;AND PARSING A DATANAME?
	  JRST	PRSNTY		;NO
	MOVE	T1,DNAME6	;GET 1ST 6 CHARS, TO CHECK FOR "TALLY"
	CAMN	T1,[SIXBIT /TALLY/]
	 JRST	PRSTLY		;GOT IT-- GO FINISH PARSING IT

PRSNTY:	TXZ	SW,FLNMOK	;FILENAMES ARE NOT ALLOWED HERE
	PUSHJ	PP,LOOKNM	;LOOKUP NAME
	 JRST	ERESET		;ERROR
	JUMPE	DT,UNDEFD	;?NOT FOUND

;IF DATANAME, LOOK FOR SUBSCRIPTS
	TXNN	SW,DNFLG
	 JRST	PRSNM5		;NO SUBSCRIPTS ALLOWED ON PROCEDURE NAMES
	MOVEI	T1,CMDBLK
	MOVEI	T2,FLNAM1	;LOOK FOR "(", CRLF, OR "OF/IN"
	PUSHJ	PP,COMMND
	HRRZ	T3,T3		;GET PARSE BLOCK USED
	CAIN	T3,FLNAM2	;CRLF?
	 JRST	[TXO	SW,CRFLG	;YES, SET FLAG
		JRST	PRSNM5]		;AND GO TO SUBSC. TAKEN CARE OF
	CAIN	T3,FLNAM3	;"OF/IN"?
	 JRST	PRSNM3		;YES, GO GET QUALIFIERS

;( SEEN - PARSE SUBSCRIPTS
NXTSBS:	MOVEI	T1,CMDBLK
	MOVEI	T2,[FLDDB. (.CMNUM,,^D10)]

;SIMULATE COMMND, SO WE CAN GIVE A BETTER ERROR MESSAGE
; IF WE GET THE TOPS20 ERROR: "First non-space character is not a digit"
	COMND%			;PARSE THE FUNCTION
	 ERJMP	LOSE		;ERROR, GO COMPLAIN
	TXNN	T1,CM%NOP	;DID IT PARSE?
	 JRST	SUBIOK		;YES, THIS SUBSCRIPT IS OK
	CAIE	T2,IFIXX2	;"FIRST NON-SPACE CHARACTER IS NOT A DIGIT"
	 JRST	LOSE		;NO, USE USUAL MESSAGE
	TYPE	[ASCIZ/
? Decimal number expected
/]
	JRST	ERESET		;RETURN AFTER TYPING REASONABLE ERROR MESSAGE

SUBIOK:	AOS	T1,NSUBS
	CAILE	T1,3		;CHECK MAX ALLOWABLE
	 JRST	STOOMN		;?TOO MANY SUBSCRIPTS
	MOVEM	T2,SUB0.-1(T1)	;STASH AWAY

;FIND TERMINATOR FOR SUBSCRIPT.
	MOVEI	T1,CMDBLK
	MOVEI	T2,FLSUTR	;LOOK FOR SUBSCRIPT TERM.
	PUSHJ	PP,COMMND	;PARSE, PARSE
				;GIVE ERROR IF NOT , OR )

	HRRZ	T3,T3		;GET PARSE BLOCK USED
	CAIE	T3,FLSUTR	; TERMINATED WITH PAREN?
	JRST	NXTSBS		;NO, GO GET MORE
;REVERSE ORDER OF SUBSCRIPTS TO EASE COMPUTATION
	MOVE	T2,NSUBS	;# SUBSCRIPTS SEEN
	MOVE	T1,SUB0.	;GET FIRST SUBSCRIPT
	EXCH	T1,SUB0.-1(T2)	;EXCHANGE WITH LAST SUBSCRIPT
	MOVEM	T1,SUB0.	;STORE LAST AS FIRST
	JRST	PRSNM5		;SUBSCRIPTS TAKEN CARE OF

;HERE IF "<CRLF>" TYPED INSTEAD OF SYMBOL--RETURN 0
RETZRO:	SETZB	W2,DT		;RETURN NO SYMBOL
	POPJ	PP,

FLSUTR:	FLDDB.	(.CMTOK,,<POINT 7,ASCRPN>,,,FLSUTC)
FLSUTC:	FLDDB.	(.CMCMA)	;COMMA


FLPRN:	FLDDB.	(.CMFLD,CM%SDH,BRMKSS,<Procedure name>)

FLSYML:	FLDDB.	(.CMCFM,CM%SDH,,<CRLF for previously typed dataname>,,FLSYMB)
FLSYMB:	FLDBK.	(.CMFLD,CM%SDH,0,<Symbol name>,,BRMKSS)

;HERE IF "OF/IN" SEEN AFTER NAME
PRSNM3:	PUSH	PP,[-1]		;MARK BOTTOM OF STACK
	PUSH	PP,DT		;SAVE PTR TO FIRST STE
PRSN3A:	MOVEI	T1,CMDBLK
	MOVEI	T2,[FLDDB. (.CMFLD,CM%SDH,BRMKSS,<Symbol name>)]
	PUSHJ	PP,COMMND
	PUSHJ	PP,COPDN6	;COPY TO DNAME6
	TXO	SW,FLNMOK	;FILE NAMES ARE ALLOWED AS QUALIFIERS
	PUSHJ	PP,LOOKNM	;GET DT FOR IT
	 JRST	ERESET		;ERROR
	JUMPE	DT,UNDEFD	;JUMP IF UNDEFINED
	PUSH	PP,DT		;SAVE ON STACK
	MOVEI	T1,CMDBLK
	MOVEI	T2,FLNAM2	;LOOK FOR "OF/IN" OR CRLF
	PUSHJ	PP,COMMND
	HRRZ	T3,T3
	CAIN	T3,FLNAM3	;OF/IN?
	 JRST	PRSN3A		;YES, GO GET ANOTHER DATANAME
	JRST	PRSN10		;CRLF, GO DO LOOKUP


;HERE IF SUBSCRIPTS TAKEN CARE OF
PRSNM5:	PUSH	PP,[-1]		;MARK BOTTOM OF STACK
	PUSH	PP,DT		;SAVE STE FOR THIS SYMBOL
	TXNE	SW,CRFLG	;SAW <CR>?
	 JRST	PRSN10		;YES, GO SEARCH FOR THIS
	MOVEI	T1,CMDBLK
	MOVEI	T2,FLNAM2	;LOOK FOR CRLF OR OF/IN
	PUSHJ	PP,COMMND
	HRRZ	T3,T3		;GET PARSE BLOCK
	CAIN	T3,FLNAM3	;OF/IN?
	 JRST	PRSN3A		;YES, GO GET QUALIFIER
	JRST	PRSN10		;GO DO FINAL LOOKUP

PRSTLY:	MOVEI	T1,CMDBLK
	MOVEI	T2,[FLDDB. (.CMCFM)] ;CONFIRM "TALLY"
	PUSHJ	PP,COMMND
	SETOB	DT,W2		;SET -1 FOR "TALLY"
	POPJ	PP,

;HERE WHEN GOT TO CRLF
;LOOKUP NAME IN TABLE, IF FOUND RETURN "W2"
PRSN10:	PUSHJ	PP,QUAL		;LOOKUP NAME IN TABLE
	 JRST	ERESET		;NOT FOUND--DON'T RETURN
PRSN11:	POP	PP,T1		;GET -1
	CAME	T1,[-1]
	JRST	.-2
	MOVE	DT,W2		;COPY TO "DT" ALSO
	POPJ	PP,		;OK, RETURN

FLNAM1:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,ASCLPN>,<Subscripts>,,FLNAM2)
FLNAM2:	FLDDB.	(.CMCFM,,,,,FLNAM3)	;CRLF
FLNAM3:	FLDDB.	(.CMKEY,CM%SDH,OFINTB,<Further Qualification>)

OFINTB:	2,,2
	[ASCIZ/IN/],,0
	[ASCIZ/OF/],,0

ASCLPN:	ASCIZ/(/
ASCRPN:	ASCIZ/)/

;ROUTINE TO COPY NAME FROM ATMBUF TO DNAME6
COPDN6:	SETZM	DNAME6		;CLEAR IT OUT FIRST
	MOVE	T1,[DNAME6,,DNAME6+1]
	BLT	T1,DNAME6+5

	DMOVE	T1,[POINT 7,ATMBUF  ;WHERE IT IS
		    POINT 6,DNAME6] ;WHERE IT SHALL BE
	MOVEI	T3,^D30		;MAX # CHARS IN A DATANAME
PRSNM1:	SOJL	T3,PRSNM2	;NAME TOO LONG , TRUNCATE
	ILDB	T4,T1		;GET A CHAR FROM DATANAME
	CAIN	T4,"-"		;TRANSFORM
	 MOVEI	T4,":"
	CAIN	T4,"."
	 MOVEI	T4,";"
	JUMPE	T4,PRSNM2	;NULL, SOMETHING ENDED THE STRING
	CAIL	T4,"A"+40	;MAKE LOWERCASE...
	CAILE	T4,"Z"+40
	 CAIA
	SUBI	T4,40		;...INTO UPPERCASE
	SUBI	T4,40		;LEGAL SIXBIT GETS TRANSFORMED
	CAIL	T4,0
	CAILE	T4,77
	 JRST	PRSN1A		;NOT LEGAL SIXBIT.. END OF DATANAME
	IDPB	T4,T2		;STORE IN WORD
	JRST	PRSNM1		;LOOP FOR MORE CHARS

PRSN1A:	LDB	T4,T1		;GET CHAR AGAIN
	HRROI	T1,[ASCIZ/? Invalid character in COBOL name: /]
	PSOUT%
	HRRZ	T1,T4
	PBOUT%			;TYPE IT
	JRST	PRSNME		;FINISH ERROR AND EXIT

PRSNM2:	MOVEI	T4,0
	IDPB	T4,T2		;STORE NULL TO END STRING
	POPJ	PP,		;RETURN WHEN DONE

UNDEFD:	HRROI	T1,[ASCIZ/?Undefined: /]
	PSOUT%
	HRROI	T1,ATMBUF
	PSOUT%
	JRST	PRSNME

STOOMN:	HRROI	T1,[ASCIZ/? Too many subscripts/]
	PSOUT%
	JRST	PRSNME

;HERE ON A PARSE ERROR.. TYPE <CRLF> TO END ERROR MESSAGE
; AND GO TO TOP LEVEL OF COMMAND SCANNER.
PRSNME:	TYPE	CRLF
	JRST	ERESET		;PARSE ERROR, GO TRY AGAIN
	

;BREAK MASK FOR COBOL SYMBOLS
	BRINI.			;[40] INITIALIZE BREAK MASK
	BRKCH.	(0,57)		;[40] SET TO BREAK ON EVERYTHING
	BRKCH.	(72,100)	;[40]  EXCEPT DIGITS AND LETTERS
	BRKCH.	(133,140)	;[40]
	BRKCH.	(173,177)	;[40]
;[40] BUT ALLOW A FEW OTHER CHARACTERS IN SYMBOLS
	UNBRK.	"-"		;[40]
	UNBRK.	"."		;[40]
BRMKSS:
	EXP	W0.,W1.,W2.,W3.	;[40]
;[D40]	1B<.CHCRT>!1B<.CHLFD>
;[D40]	0
;[D40]	0
;[D40]	0




;ROUTINES FOR COMND JSYS
NOISE:	HRROM	T2,NOIBLK+.CMDAT	;SAVE AS DATA
	MOVEI	T2,NOIBLK	;POINT TO BLOCK
	JRST	COMMND		;AND GO TO COMND JSYS
CONFRM:	MOVEI	T1,CMDBLK	;POINT TO COMMAND BLOCK
	MOVEI	T2,[FLDDB. (.CMCFM)] ;GET CONFIRM FUNCTION
COMMND:	COMND%			;PARSE THE FUNCTION
	 ERJMP	LOSE		;ERROR, GO COMPLAIN
	TXNE	T1,CM%NOP	;DID IT PARSE?
	 JRST	LOSE		;NO, COMPLAIN
	POPJ	PP,		;YES, RETURN SUCESSFULLY

NOIBLK:	FLDDB.	(.CMNOI)	;BLOCK FOR NOISE FUNCTION

LOSE:	HRROI	T1,[ASCIZ/
? /]
	PSOUT%
	PUSHJ	PP,LSTFRC	;TYPE LAST ERROR IN THIS FORK, THEN CRLF
ERESET:	MOVEI	T1,.PRIIN	;GET READY
	CFIBF%			;CLEAR INPUT STRING
	MOVE	PP,PDL.		;GET PUSHDOWN STACK WE STARTED WITH
	JRST	DECOD		;GO TRY AGAIN	


;TYPE LAST ERROR IN THIS FORK
LSTFER:	MOVEI	T1,.PRIOU	;OUTPUT TO TTY
	HRLOI	T2,.FHSLF	;LAST ERROR IN THIS FORK
	SETZ	T3,		;ALL OF THE TEXT
	ERSTR%
	  TRNA
	  TRN
	POPJ	PP,

;DO LSTFER THEN CRLF
LSTFRC:	PUSHJ	PP,LSTFER	;TYPE LAST ERROR IN THIS FORK
	TYPE	CRLF		;TYPE CRLF
	POPJ	PP,		;THEN RETURN
>;END IFN TOPS20 3
; **** END OF TOPS20 COMMAND SCANNER ****

;*** END OF ALL COMMAND SCANNER ROUTINES ***

SUBTTL	COMMAND PROCESSORS -- WHERE

;HERE WHEN "WHERE<CRLF>" SEEN
;PRINT SUMMARY OF BREAK POINTS
WHERE:	TYPE	CRLF
	SKIPE	T2,EBRKOV	;IF WE'RE STOPED AT AN ENTRY,
				; TYPE A SPECIAL MSG.
	JRST	[TYPE [ASCIZ "Program stopped upon entry to module "]
		PUSHJ	PP,	PRTMNM
		JRST	WHERE1]
	SKIPE	REEFLG		;[26] SPECIAL BREAK?
	 JRST	WHER1A		;[26] YES, DON'T TRY TO REPEAT MESSAGE.
	SKIPN	CUR.BP		;[26] ARE WE AT NORMAL BREAK?
	JRST	WHER1A		;[26] SKIP BREAK MESSAGE
	TYPE	[ASCIZ "Program stopped at "]
	MOVEI	T4,CBPADS		;PICK UP ADDRESS OF THE CURRENT
					; BREAK POINT'S PROTAB POINTERS.
	PUSHJ	PP,PRTBP	;PRINT BREAK MESSAGE
WHERE1:	TYPE	CRLF
WHER1A:	TYPE	[ASCIZ " Break-points:
"]
	MOVEI	T5,0		;INIT COUNTER OF FREE BPS
	MOVEI	T4,B1ADR	;INIT LOOP
WHERE2:	SKIPN	0(T4)		;IN USE?
	AOJA	T5,WHERE3	;NO: INCREMENT CNTR
	TYPEC	" "		;TYPE A SPACE
	PUSHJ	PP,PRTBP	;YES: PRINT IT
	TYPE	CRLF
WHERE3:	ADDI	T4,LBA
	CAIG	T4,BNADR	;DONE?
	JRST	WHERE2
	CAIL	T5,NBP		;WAS THERE ANY?
	JTYPE	[ASCIZ " **NONE**
"]
	TYPEC	" "		;TYPE A SPACE
	PUSHJ	PP,PRNUM	;PRINT # OF FREE
	PTYPE	[ASCIZ " unused break-points"]
	JRST	XECUTC

CRLF:	BYTE (7)15,12
;PRINT BREAK POINT INFOR POINTED AT BY 'T4'
ANGLIN:	BYTE (7)74,74
ANGLOU:	BYTE (7)76,76

PRTBP:	PUSH	PP,T5
	TYPE	ANGLIN
	HLRZ	T5,1(T4)
	HRRZ	T5,1(T5)
	HRRZ	T2,0(T4)
	LDB	DT,[POINT 15,0(T2),17]
	ADD	DT,%%NM.(T5)
	PUSHJ	PP,PRNAM
	HRRZ	T2,1(T4)	;CHECK ON SECTION NAME
	JUMPN	T2,PRTBP1	;[26] NO SECTION NAME ADDRESS MEANS
				;THE NAME ITSELF IS A SECTION NAME
	TYPE	[ASCIZ " SECTION"] ;[26]
	JRST	PRTBP2		;[26]

PRTBP1:	LDB	DT,[POINT 15,0(T2),17] ;[26] GET NAMTAB POINTER
	ADD	DT,%%NM.(T5)
	MOVE	T2,1(DT)
	CAME	T2,[SIXBIT /:GENER/] ;DON'T PRINT IF IT ISN'T USER NAME
	PUSHJ	PP,[TYPE [ASCIZ " in "]
		    JRST PRNAM]
PRTBP2:	HLRZ	T2,1(T4)	;[26]
	SKIPE	SUBSPR		;SKIP IF NO MODULES BESIDES THE MAIN ONE
	PUSHJ	PP, [	TYPE [ASCIZ " in module "]
			JRST	PRTMNM]
	TYPE	ANGLOU
	POP	PP,T5
	POPJ	PP,

;YE OLDE RECURSIVE NUMBER PRINTER C(T5)

PRNUM:	MOVE	T4,T5		;COPY TO T4
IFN TOPS20,<
	PUSH	PP,T1		;SAVE T1
	PUSHJ	PP,PRNUM0	;CALL ROUTINE
	POP	PP,T1		;RESTORE T1
	POPJ	PP,		;RETURN
>
PRNUM0:	IDIVI	T4,^D10
	HRLM	T5,0(PP)
	JUMPE	T4,PRNUM1
	PUSHJ	PP,PRNUM0
PRNUM1:	HLRZ	T3,0(PP)
	ADDI	T3,"0"
	TYPEAC	T3
	POPJ	PP,
SUBTTL	COMMAND PROCESSORS -- TRACE

;HERE TO SET TRACE ON/OFF
; IF ON, W2=-1, IF "OFF", W2=0
TRCONF:	MOVEM	W2,PTFLG.	;SAVE ON/OFF VALUE
	JRST	XECUTX

;HERE IF "TRACE BACK" TYPED
TRCB:	PUSHJ	PP,PPOT4.	;CALL LIBOL ROUTINE
	JRST	XECUTX		;RETURN

SUBTTL	COMMAND PROCESSORS -- BREAK

;BREAK POINT LOGIC

;COME HERE TO EXECUTE A "BREAK" COMMAND.  NOTE THAT EXECUTING A
;BREAK COMMAND JUST MEANS SETTING UP THE PARAMETERS FOR THE BREAKPOINT.
;THE ACTUAL 'INSTALLATION' OF THE BREAK CODE (JSR) IS DONE LATER.
;AND THE 'BREAK' ITSELF OCCURS ONLY WHEN CONTROL PASSES THRU THE
;NAMED PROCEDURE NAME WHERE THE JSR HAS BEEN 'INSTALLED'.

;LOOK FOR FREE SLOT IN THE TABLE THAT CONTAINS THE 20 BREAKPOINT PARAMETERS.
SETBRK:	MOVEI	T5,B1ADR	;GET BASE ADDRESS
STBRK0:	HRRZ	T4,0(T5)
	CAIN	T4,0(DT)	;CHECK IF WE HAVE THIS BREAK ALREADY
	 JRST	[TYPE [ASCIZ/% Breakpoint was there already
/]
		JRST	STBRK1]	;GO INSTALL AGAIN ANYWAY
	SKIPN	0(T5)		;NO, IS THIS SLOT EMPTY?
	JRST	STBRK1		;USE THIS ONE
	ADDI	T5,LBA		;NEXT ENTRY
	CAIG	T5,BNADR	;LAST?
	JRST	STBRK0

	TYPE	[ASCIZ "?Out of break-points"]
	JRST	XECUTC

;GET ADDRESS OF PROTAB ENTRY FOR FATHER (SECTION)
STBRK1:	HRRZ	T2,PR.FLG(DT)	;[26] IS THIS NAME A SECTION NAME?
	ANDI	T2,PR%SEC	;[26]
	JUMPE	T2,STBRK2	;[26]
	LDB	T2,[POINT 15,1(DT),17] ;[26] NO, GET FATHER'S ADDRESS
	ADD	T2,@%PR
STBRK2:	HRRZ	T4,1(DT)	;[26] GET ADDRESS OF THE BREAK

;PROHIBIT THE BREAK IF THE ADDRESS IS IN A WRITE-PROTECTED HIGH SEGMENT.
IFE TOPS20,<
	CAMG	T4,.JBREL	;IS ADDRESS IN HIGH-SEG?
	JRST	STBRK3		;NO
	SETZ	T3,		;YES, SEE IF WRITE-PROTECT OFF
	SETUWP	T3,		;BY TURNING IT OFF AGAIN
	  JRST	HIPART		;ERROR, MUST BE ON
	JUMPE	T3,STBRK3	;WAS OFF BEFORE - IT STILL IS
	SETUWP	T3,		;WAS ON BEFORE - SET IT BACK ON
	  JFCL
	JRST	HIPART		; AND FAIL

STBRK3:>
	MOVEM	DT,0(T5)	;PROTAB ADDR OF PAR NAME.
	MOVEM	T2,1(T5)	;PROTAB ADDR OF SECT NAME.
	MOVE	T2,CUREPA	;SAVE THE CURRENT ENTRY POINT'S
	HRLM	T2,1(T5)	; ADDRESS TOO.
	SETZM	2(T5)		;CLR PROCEED COUNTER
	JRST	XECUTX
SUBTTL	COMMAND PROCESSORS -- CLEAR

;COME HERE TO EXECUTE A CLEAR COMMAND.  NOTE THAT EXECUTING A CLEAR
;COMMAND MEANS ZEROING THE BREAK PARAMETERS.  THE ACTUAL 'REMOVAL'
;OF THE BREAK CODE (JSR) HAS ALREADY BEEN DONE.  THOSE THAT ARE STILL
;'SET' WHEN A 'PROCEED' OR 'GO' IS EXECUTED ARE AUTOMATICALLY REINSTALLED.

;CLEAR ALL BREAK PARAMETERS IF NO PROC NAME WAS GIVEN ON THE COMMAND.
CLRBRK:	JUMPN	DT,CLBRK0
	MOVE	T5,[XWD B1ADR,B1ADR+1]	;CLEAR ALL
	SETZM	B1ADR
	BLT	T5,BNADR+LBA-1
	JRST	XECUTX

;CLEAR ONLY THE ONE THAT WAS NAMED IN COMMAND.
CLBRK0:	MOVEI	T5,B1ADR	;GET TABLE BASE
CLBRK1:	HRRZ	T4,0(T5)
	CAIN	T4,0(DT)
	JRST	CLBRK2		;FOUND
	ADDI	T5,LBA		;NEXT ENTRY
	CAIG	T5,BNADR	;LAST ENTRY?
	JRST	CLBRK1		;LOOP UNTIL NO MORE
	TYPE	[ASCIZ/% Breakpoint was not set
/]
	JRST	XECUTX		;JUST QUIT

CLBRK2:	SETZM	0(T5)		;CLEAR 3 PARAMETER WORDS
	SETZM	1(T5)
	SETZM	2(T5)
	JRST	XECUTX

SUBTTL	COMMAND PROCESSORS -- UNPROTECT

;COME HERE TO EXECUTE A TOPS-10 UNPROTECT HI-SEG COMMAND.

IFE TOPS20,<
UNPROT:	SETZ	T5,		;SET FUNCTION TO CLEAR WRITE PROTECT
	SETUWP	T5,		;DO IT
	  JRST	UNPERR		;FAILED
	HRRZ	T5,.JBSA	;OK, GET START ADDRESS
	MOVS	T4,(T5)		;GET FIRST WORD
	CAIE	T4,(JFCL)	;INITIAL FIRST INSTRUCTION?
	JRST	XECUTX		;NO, WE HAVE DONE RESET ALREADY
	MOVE	T5,2(T5)	;GET JSP 16,C.RSET
	MOVS	T5,2(T5)	;THIS SHOULD BE THE RESET UUO
	CAIE	T5,(RESET)	;IS IT?
	JRST	XECUTX		;NO, GIVE UP
	MOVE	T4,[JSP	1,UNPST.]	;WHERE WE WANT START TO GO TO
	HRRM	T4,(T5)		;CHANGE JRST .+2
	JRST	XECUTX		;ALL DONE

UNPERR:	OUTSTR	[ASCIZ	/?SETUWP UUO failed
/]
	JRST	XECUTX

;ENTER HERE FROM RESET CODE IN LIBOL TO TURN OFF USER WRITE PROTECTION
;AFTER THE RESET HAS BEEN DONE
;CALLED BY JSP 1,UNPST.

UNPST.:	RESET			;DO THE RESET NOW
	SETZ	T2,
	SETUWP	T2,		;TURN OFF WRITE-PROTECT AGAIN
	  JFCL			;TOO BAD
	JRST	(T1)		;RETURN
>
SUBTTL	COMMAND PROCESSORS -- STOP

;COME HERE TO EXECUTE A STOP RUN COMMAND.
;JUST USE THE LIBOL CODE.  THE LIBOL CODE WILL REENTER COBDDT
;IF THERE IS A HISTORY THAT NEEDS TO BE TERMINATED.  IT HAS TO BE
;PREPARED TO DO THAT IF THE USER DID THE STOP RUN FROM HIS CODE
;INSTEAD OF FROM THE TERMINAL.

STOPR:	PUSHJ	PP,STOPR.##
SUBTTL	COMMON ROUTINE TO HANDLE BREAK
;ENTERED BY THE JSA T2,BCOM THAT IS IN THE BP TABLE.
;THE JSA GOT CONTROL FROM A JSR THAT WAS INSTALLED IN THE GENERATED CODE.
;AC'S ARE ALL IN USER PROGRAM STATE.  ONLY TA CAN BE USED.
;THIS COMMON CODE SETS UP INDIRECT POINTERS TO BE USED BY
;THE REST OF THE BREAK HANDLER CODE,  SO THE REST OF THE BREAK HANDLER
;CODE GOES INDIRECT TO THE PARAMETERS FOR THIS BREAK.

BCOM:	Z			;JSA T2,BCOM
	SETZM	EBRKOV		;[26] IN CASE AN OVERLAY
				;[26] MODULE HAD NO SYMBOLS
	POP	T2,LEAV		;GET EXIT INSTRUCTION
	MOVEI	T2,B1SEC-B1INS+1(T2) ;GET ADDRESS OF SECTION'S
				;PROTAB ENTRY
	HRRZM	T2,BCOM3
	MOVEI	T2,B1CNT-B1SEC(T2) ;GET ADDRESS OF PROCEED COUNT
	HRRZM	T2,BCOM2
	MOVE	T2,BP1-B1CNT(T2) ;GET RETURN ADDRESS
	HLLM	T2,LEAV1	;SAVE FLAGS
	EXCH	T2,BCOM
	SKIPLE	STPCTR		;[30] IS "STEP" IN EFFECT?
	 JRST	BCOM0		;[30] YES, DON'T BREAK
	SOSG	@BCOM2		;TEST PROCEED COUNTER
	JRST	BREAK		;BREAK - ALL AC'S IN PLACE

;NOT TIME TO BREAK YET, RETURN TO USER'S CODE.

BCOM0:	MOVEM	T2,SAV.T2	;[30] STASH 'T2'
	LDB	T2,[POINT 9,LEAV,8] ;GET SWAPPED INSTRUCTION'S OPCODE
				;TO SEE OF WE CAN JUST EXECUTE IT,
				;OR WHETHER IT MUST BE INTERPRETED.
	CAIL	T2,(<JSR>/1000)
	CAILE	T2,(<JSA>/1000)	;JSA,JSP
	TRNN	T2,700		;UUO?
	JRST	PRCED1		;YES: USE PROCEED CODE
	CAIE	T2,(<PUSHJ>/1000)
	CAIN	T2,(<XCT>/1000)	;PUSHJ,XCT?
	JRST	PRCED1		;MUST ALSO BE INTERPRETED
	MOVE	T2,SAV.T2	;OK TO JUST EXIT
	JRSTF	@LEAV1		;EXIT
;HERE TO BREAK - SAVE WORLD AND SET UP PDL

BREAK:	JSR	SAVE		;...
	SKIPE	HFGTHR		;IF WE'RE DOING A HISTOGRAM, GO
	PUSHJ	PP,HABP		; ACCUMULATE STATISTICS.
	PUSHJ	PP,REMOVB	;REMOVE BREAK-POINTS
	TYPE	[ASCII "Break at "]
	TYPE	ANGLIN
	MOVE	T2,BCOM2
	SUBI	T2,2		;GET ADDR OF BP
	MOVEM	T2,CUR.BP	;SAVE IT
	MOVE	DT,1(T2)	;POINTER TO SECTION NAME.
	MOVEM	DT,CBPADS+1
	HRRZ	T2,0(T2)	;PNTR TO PROTAB
	MOVEM	T2,CBPADS	;SAVE IT IN CASE HE CLEARS
				; THE BREAK POINT.
	LDB	DT,[POINT 15,0(T2),17]
	HRRZ	T2,1(T2)	;ADDR IN USER'S PROGRAM
	HRRM	T2,PRCED0
	ADD	DT,@%NM		;NAMTAB ENTRY
	PUSHJ	PP,PRNAM	;PRINT BP NAME
	HRRZ	T2,@BCOM3	;GET SECTION NAME
	JUMPN	T2,BREAK1	;[26] NO SECTION NAME?
	TYPE	[ASCIZ " SECTION"] ;[26]  MUST BE A SECTION NAME
	JRST	BREAK2		;[26]
BREAK1:	LDB	DT,[POINT 15,0(T2),17] ;[26] GET NAMTAB ENTRY FOR SECTION NAME
	ADD	DT,@%NM
	MOVE	T2,1(DT)	;GET FIRST WORD OF NAME
	CAME	T2,[SIXBIT /:GENER/] ;SKIP IF IT'S COMPILER GENERATED
	PUSHJ	PP,[PTYPE [ASCIZ " in "]
		    JRST PRNAM]
BREAK2:	HLRZ	T2,@BCOM3	;GET ENTRY POINT
	SKIPE	SUBSPR		;ARE THERE OTHER MODULES?
	PUSHJ	PP, [	TYPE [ASCIZ " in module "]
			JRST	PRTMNM]
	TYPE	ANGLOU
;BREAK COMMAND -- CONTINUED

;	SET UP FOR BREAKING- SO THAT LIBOL PARAMS HAVE MODULE PROG
; FIRST MOVE LIBOL TO RUN TIME PARAMS
	MOVE	T2,@%NM		; [13] ADDR OF %NM
	MOVEM	T2,PNM		; [13] STORE INTO PROCEED 
	MOVE	T2,@%DT		; [13] ADDR OF %DT
	MOVEM	T2,PDT		; [13] STORE INTO PROCEED 
	MOVE	T2,@%PR		; [13] ADDR OF %PR
	MOVEM	T2,PPR		; [13] STORE INTO PROCEED 
; NOW PUT BREAK PARAMS INTO LIBOL
	MOVE	T2,BNM		; [13] GET BREAK NM
	MOVEM	T2,@%NM		; [13] STORE INTO LIBOL NM
	MOVE	T2,BDT		; [13] GET BREAK DT
	MOVEM	T2,@%DT		; [13] STORE INTO LIBOL DT
	MOVE	T2,BPR		; [13] GET BREAK PR
	MOVEM	T2,@%PR		; [13] STORE INTO LIBOL PR
	JRST	XECUTC		;INTO MAIN LOOP
SUBTTL	COMMAND PROCESSORS -- STEP / PROCEED

;COME HERE TO EXECUTE A 'STEP' COMMAND.
;COUNT IN W2
STEP:	SKIPE	CUR.BP		;[30] STEPPING FROM A BREAKPOINT?
	 ADDI	W2,1		;[30] YES, IGNORE THIS TRACE CALL
	MOVEM	W2,STPCTR	;[26] SAVE COUNTER, USE 'PROCEED' CODE.
	MOVEI	W2,1		;PROCEED COUNT = 1


;COME HERE TO EXECUTE A PROCEED COMMAND.

PROCED:	SKIPE	HFGTHR		;IF WE WERE DOING A HISTOGRAM
	JRST	HISSTE		; GO DO A BEGIN SO THAT WE DON'T
				; ADD THE TIME WE SPENT IN COBDDT
				; TO THE CURRENT PARAGRAPH.
;COME HERE TO 'AUTOMATICALLY PROCEED'
PRCEDD:	SKIPE	DIED.		;ARE WE ALIVE?
	JRST	[TYPE	[ASCIZ "?Cannot PROCEED!"]
		 JRST XECUTC]	;NO
;IF THIS IS ONLY A SIMULATED BREAKPOINT (STEP OR ^C/REENTER),
;REEFLG WILL BE ON, MEANING WE ENTERED COBDDT WITH A PUSHJ AND CAN
;RETURN WITH A POPJ.
	SKIPE	REEFLG		; [21] TIME TO REENTER?
	JRST	REERTN		; [21] YES
; SET UP TO PROCEED-SO THAT LIBOL HAS RUN-TIME PARAMS
; FIRST MOVE LIBOL INTO BREAK
	MOVE	T1,@%NM		; [13] ADDR OF %NM
	MOVEM	T1,BNM		; [13] STORE INTO BREAK 
	MOVE	T1,@%DT		; [13] ADDR OF %DT
	MOVEM	T1,BDT		; [13] STORE INTO BREAK 
	MOVE	T1,@%PR		; [13] ADDR OF %PR
	MOVEM	T1,BPR		; [13] STORE INTO BREAK 
; NOW PUT PROCEED PARAMS INTO LIBOL
	MOVE	T1,PNM		; [13] GET PROCEED NM
	MOVEM	T1,@%NM		; [13] STORE INTO LIBOL NM
	MOVE	T1,PDT		; [13] GET PROCEED DT
	MOVEM	T1,@%DT		; [13] STORE INTO LIBOL DT
	MOVE	T1,PPR		; [13] GET PROCEED PR
	MOVEM	T1,@%PR		; [13] STORE INTO LIBOL PR
	SKIPE	EBRKOV		;ENTRY POINT BREAK?
	JRST	PROV		;YES, GO CONTINUE WITHOUT
				; RESTORING EVERYTHING.
	SKIPN	T1,CUR.BP	;CURRENT?
	JRST	START		;NO: START USERS PROG
	SKIPN	W2		;NUMBER GIVEN
	MOVEI	W2,1		;NO: ASSUME ONE
	MOVEM	W2,2(T1)	;SAVE COUNT
PRCED0:	HRRZI	T1,0		;ADDR MODIFIED !!!
	PUSHJ	PP,FETCH	;GET INSTRUCTION
	MOVEM	T2,LEAV
	PUSHJ	PP,INSRTB	;INSERT BREAK-POINTS
	JRST	PRCED2
;COME HERE FROM BREAK WHICH DID NOT ACTUALLY BREAK BECAUSE
;ITS PROCEED COUNT HAS NOT GONE TO 0 YET.
PRCED1:	MOVE	T2,SAV.T2	;GET SAVED AC
	JSR	SAVE		;SAVE WORLD

PRCED2:	MOVEI	T3,100		;SET MAX LOOP COUNT
	MOVEM	T3,TEMP1
	JRST	IXCT5

IXCT4:	CAIL	T2,40		;SYSTEM UUO?
	JRST	IXCT6		;YES: DON'T INTERPRET
	MOVEM	T1,40		;SAVE UUO
	MOVEI	T1,41

IXCT:	SOSG	TEMP1		;LOOPING
	JRST	BPLUP
	PUSHJ	PP,FETCH
	MOVEM	T2,LEAV		;STASH INSTR

IXCT5:	HRLZI	17,AC0		;TEMP FETCH OF ACS
	BLT	17,17
	MOVEI	T2,@LEAV	;GET EFFECTIVE ADDRS
	DPB	T2,[POINT 23,LEAV,35]
	LDB	T3,[POINT 4,LEAV,12]
	LDB	T2,[POINT 9,LEAV,8]
	CAIN	T2,(<PUSHJ>/1000)
	JRST	IPUSHJ		;INTERPRET PUSHJ
	CAIN	T2,(<JSR>/1000)
	JRST	IJSR		;INTERPRET JSR
	CAIN	T2,(<JSP>/1000)
	JRST	IJSP		;INTERPRET JSP
	CAIN	T2,(<JSA>/1000)
	JRST	IJSA		;INTERPRET JSA
	MOVE	T1,LEAV
	TRNN	T2,700
	JRST	IXCT4		;INTERPRET UUO
	CAIN	T2,(<XCT>/1000)
	JRST	IXCT		;INTERPRET XCT
IXCT6:	MOVEI	T2,LEAV
IXCT7:	SETOM	TEMP2
IXCT8:	JRST	RESTOR
;VARIOUS INTERPRETERS

IPUSHJ:	DPB	T3,[POINT 4,CPUSHP,12]
	SETZM	TEMP2		;STORE AC FIELD INTO A PUSH
	MOVE	T2,LEAV
	JRST	IXCT8

IJSA:	MOVE	T2,BCOM
	HRL	T2,LEAV
	EXCH	T2,AC0(T3)
	JRST	IJSR2

IJSR:	MOVE	T2,BCOM
	HLL	T2,FLGS.
IJSR2:	MOVE	T1,LEAV
	PUSHJ	PP,DEP
	AOSA	T2,LEAV
ISR3:	MOVE	T2,LEAV
	JRST	IXCT7

IJSP:	MOVE	T4,BCOM
	HLL	T4,FLGS.
	MOVEM	T4,AC0(T3)
	JRST	ISR3

;COME HERE IF BREAK POINT LOOPING

BPLUP:	PUSHJ	PP,REMOVB
	JSR	SAVE
	PTYPE	[ASCIZ "?Fatal break-point error!"]
	JRST	XECUTC
;SAVE AND RESTORE WORLD CODE

SAVE:	Z			;JSR ENTRY
	MOVEM	17,PDL.		;CURRENT PDL
	MOVEM	17,AC0+17
	HRRZI	17,AC0
	BLT	17,AC0+16	;SAVE AC'S
	MOVE	T2,SAVE		;SAVE PROCESSOR FLAGS
	HLLM	T2,FLGS.
	MOVE	PP,PDL.		;RESTORE STACK POINTER
	JRST	@SAVE

;PROCEED CODE FOR PROCEEDING FROM ^C/REENTER OR STEP COMMAND.
REERTN:	PUSHJ	PP,INSRTB	; [26]  INSERT ANY BREAKPOINTS
	MOVE	T2,REEFLG	; [21] GET ORIGINAL PDL
	SETZM	REEFLG		; [21] CLEAR
	MOVE	T1,0(T2)	; [21] GET DATA + FLAGS
	CAME	T2,AC0+PP	; [21] SAME ?
	HALT	.		; [21] NO
	POP	T2,0(T2)	; [21] CORRECT FOR JUMP
	MOVEM	T2,AC0+PP	; [21]
	HLLZM	T1,FLGS.	; [21] SET FLAGS AND FALL THROUGH
	MOVEI	T2,0(T1)	; [21]
	SETOM	TEMP2		; [21] NO PUSH 0 NECESSARY

RESTOR:	HLL	T2,FLGS.
	MOVEM	T2,SAVE		;SAVE EXIT ADDR. AND FLAGS
	HRLZI	17,AC0
	BLT	17,17		;RESTORE AC'S
	SKIPL	TEMP2
CPUSHP:	PUSH	.-.,BCOM	;AC MODIFIED AT IPUSHJ
	JRSTF	@SAVE		;EXIT

;COME HERE TO START USER'S PROGRAM

START:	PUSHJ	PP,INSRTB	;INSERT BREAK-POINTS
	MOVE	PP,PDL.
	JRST	@PROGST

;CODE TO FETCH THE USER'S INSTRUCTION AT POINT OF BREAK.
FETCH:	TRNN	T1,-20		;IS IT IN AN AC?
	SKIPA	T2,AC0(T1)	;YES: FETCH FROM SAVED AC'S
	MOVE	T2,0(T1)	;NO
	POPJ	PP,

;CODE TO DEPOSIT AN INSTRUCTION AT THE POINT OF BREAK.
DEP:	TRNN	T1,-20		;IS IT IN AN AC?
	JRST	DEP1		;YES
	MOVEM	T2,0(T1)	;NO
	POPJ	PP,
DEP1:	MOVEM	T2,AC0(T1)	;STORE INTO THE SAVED AC
	POPJ	PP,
;CODE TO REMOVE OR INSERT BREAKPOINTS

INSRTB:	MOVE	T5,[JSR BP1]
	MOVEI	T4,B1ADR
INSRT1:	SKIPE	T1,(T4)		;IF THE BP ISN'T ACTIVE OR IS
	PUSHJ	PP,CHKBP	; IN A NON RESIDENT SEGMENT,
	JRST	INSRT2		; DON'T INSERT IT.
	HRRZ	T1,1(T1)	;YES: GET ADDR OF BP
	PUSHJ	PP,FETCH	;GET USER'S INSTRUCTION
	CAME	T2,T5		;[26] DON'T STORE IT IF A BREAK
				;IS ALREADY THERE (^C/REENTER PROBLEM)
	MOVEM	T2,2(T5)	;SAVE IT
	MOVE	T2,T5
	PUSHJ	PP,DEP		;DEPOSIT "JSR"
INSRT2:	ADDI	T5,LBP
	ADDI	T4,LBA
	CAIG	T4,BNADR	;DONE??
	JRST	INSRT1
	SETZM	CUR.BP		;[26] FORGET CURRENT BREAK
	POPJ	PP,		;YES:

REMOVB:	MOVEI	T5,BP1
	MOVEI	T4,B1ADR
REMOV1:	SKIPE	T1,(T4)		;IF THE BP ISN'T ACTIVE OR IS
	PUSHJ	PP,CHKBP	; IN A NON RESIDENT SEGMENT,
	JRST	REMOV2		; DON'T REMOVE IT.
	HRRZ	T1,1(T1)	;GET ADDR OF USER'S INSTRUCTION
	MOVE	T2,2(T5)	;GET USER'S INSTRUCTION
	PUSHJ	PP,DEP		;PUT IT BACK
REMOV2:	ADDI	T5,LBP
	ADDI	T4,LBA
	CAIG	T4,BNADR
	JRST	REMOV1
	POPJ	PP,
;COME HERE FROM LIBOL'S SEGMENT HANDLER TO PUT ANY BREAKPOINTS IN THE
; SEGMENT WHICH IT HAS JUST READ IN.

SBPSG.:	MOVE	T5,	[JSR	BP1]
	MOVEI	T4,	B1ADR
SBPSGD:	SKIPE	T1,	(T4)		;IF THERE ISN'T A BP SET OR
	PUSHJ	PP,	CHKBP		; IT ISN'T IN THIS SEGMENT OR
	JRST		SBPSGH		; IT'S IN THE RESIDENT SEGMENT,
	JUMPE	T3,	SBPSGH		; DON'T MESS WITH IT.
	HRRZ	T1,	1(T1)		;GET THE ADDRESS AT WHICH TO SET IT.
	PUSHJ	PP,	FETCH		;GO GET THE INSTR WHICH IS THERE.
	MOVEM	T2,	2(T5)		;SAVE IT AND REPLACE IT
	MOVE	T2,	T5		; WITH A JSR TO THE APPROPRIATE
	PUSHJ	PP,	DEP		; BREAK POINT.
SBPSGH:	ADDI	T5,	LBP		;BUMP UP TO THE NEXT BREAK
	ADDI	T4,	LBA		; POINT.
	CAIG	T4,	BNADR		;IF THERE ARE MORE,
	JRST		SBPSGD		; LOOP.
	POPJ	PP,			;OTHERWISE RETURN.


;CHECK TO SEE IF A BREAKPOINT IS IN A NON-RESIDENT SEGMENT WHICH IS
; NOT CURRENTLY IN CORE.  IF IT IS RESIDENT OR IS CURRENTLY IN CORE
; TAKE THE SKIP RETURN.  ENTER WITH (T1) = BREAKPOINT'S ADDRESS.
; LEAVE WITH (T3) = THE SEGMENT PRIORITY FOR THIS PARAGRAPH/SECTION.

CHKBP:	LDB	T3,	[POINT	7,2(T1),24]	;GET THE PRIORITY.
	TRNE	T3,	-1		;IF IT'S RESIDENT OR IT'S
	CAMN	T3,	SEGNO.##	; PRIORITY IS THE SAME AS THE
	AOS		(PP)		; CURRENT SEGMENT'S, TAKE
	POPJ	PP,			; THE SKIP RETURN.
;PRINT NAME FOUND POINTED AT IN DT

PRNAM:	HLRZ	T2,0(DT)	;GET # OF WORDS
	HRRZI	T1,1(DT)	;GET ADDR OF FIRST
	HRLI	T1,(<POINT 6,,>);MAKE BP
PRNAM1:	ILDB	T3,T1
	JUMPE	T3,PRNAM2	;DONE IF ZERO
	ADDI	T3,40		;CONVERT TO ASCII
	CAIN	T3,":"
	 MOVEI	T3,"-"
	CAIN	T3,";"
	 MOVEI	T3,"."
	TYPEAC	T3
	TLNE	T1,770000	;WORD FINISHED
	JRST	PRNAM1		;NO: LOOP
	SOJG	T2,PRNAM1	;YES: CHECK IF THAT'S ALL
PRNAM2:	POPJ	PP,		;ALL DONE - EXIT

;PRINT THE MODULE'S NAME.  ENTRY POINT ADDR IS IN T2.

PRTMNM:	MOVE	T2,-1(T2)	;Get sixbit name from addr-1.
	JRST	SIXSIX		;Go type it

;PRINT THE OCTAL NUMBER IN T2.

PROCT:	PUSHJ	PP,PROCTD	;Type first six digits
	TYPEC	<",">
PROCTD:	SETOI	T1,
PROCTH:	HRRI	T1,6		;This will get octal 60
	LSHC	T1,3		;Add in digit, make octal 6x.
	TYPEAC	T1		;Type 0 thru 7.
	JUMPL	T1,PROCTH	;Loop for six digits
	POPJ	PP,
SUBTTL	C.TRCE CODE -- PERFORM "TRACE" FOR COBOL PROGRAM

;ENTER COBDDT HERE FROM ALL TRACEABLE POINTS IN THE USER PROGRAM.
;	PUSHJ	PP,C.TRCE
;	XWD			;ARGUMENT WORD
;THE ARGUMENT WORD CONTAINS:
;BITS 0-8	FLAGS
;	BIT 3	DEBUGGING MODE REQUIRED
;	BIT 4	EXIT PROGRAM
;	BIT 5	GOBACK
;	BIT 7	PROGRAM ENTRY
;	BIT 8	ALTERNATE ENTRY
;BITS 9-17	ARGUMENT WORD COUNT (1 OR 2)
;BITS 18-35	POINTER TO PROTAB ENTRY FOR THIS PROCEDURE NAME.
;
;NAMES PRINTED BY THE TRACE ARE PRECEDED BY A STRING OF *'S AND !'S.
;A * INDICATES A PERFORM THAT IS ACTIVE, AND A ! INDICATES A CALL.
;TRACE KEEPS TRACK OF UP TO 35 OF THESE CHARACTERS.

;IS THIS THE FIRST TRACE CALL FOLLOWING A REENTER FROM MONITOR LEVEL?
C.TRCE:	SKIPE	REEBRK		;[26] REENTER BREAK?
	JRST	[PTYPE	[ASCIZ /
Program interrupted at /]
		SETZM	STPCTR
		JRST	.+1]		;[26] YES
	HRRZ	T2,(PP)		;[26] GET ARG PTR
	HRRZ	T1,(T2)		;GET PROTAB LINK IF ANY
	HLRZ	T2,(T2)		;GET ARG COUNT AND FLAGS
	LDB	T5,[POINT 9,T2,35]	;GET ARG COUNT
	TRNE	T2,TC.GB	;GOBACK?
	JRST	TRACE0		;YES
	TRNE	T2,TC.EP	;EXIT PROGRAM?
	JRST	TRACE1		;YES
	TRNE	T2,TC.PE!TC.AE	;PROGRAM-ENTRY OR OTHER ENTRY?
	JRST	TRACE2		;YES
	SKIPE	HFGTHR		;IF WE'RE DOING A HISTOGRAM GO
	PUSHJ	PP,HAPS		; ACCUMULATE STATISTICS.
; SAVE THIS PROTAB ADDRESS AS NAME TO BE PRINTED IF PROGRAM GETS
; AN ABORT ERROR.
	MOVE	T3,ACTEPA	;[46] Actual entry point
	HRRZ	T3,1(T3)	;[46] Low segment data for current module
	HRRZ	T2,%%NM.(T3)	;[46] Namtab table address
	SKIPN	T2		;[46] Any symbols?
	JRST	[SETZM	L.SECT
		SETZM	L.PARA
		JRST	CTRCE1]		;NO
	HRRZ	T3,%%PR.(T3)	;[46] Protab table address
	ADD	T1,T3		;[46] Protab entry for current routine
	MOVEM	T1,L.PARA	;[26] ASSUME PARAGRAPH
	MOVE	T3,PR.FLG(T1)	;[26] GET PAR/SECT FLAG
	TRNN	T3,PR%SEC	;[26] IS IT PARA?
	JRST	[MOVEM	T1,L.SECT
		SETZM	L.PARA
		JRST	CTRCE1]		;[26] NO, NEW SECTION
CTRCE1:	PUSHJ	PP,STPCHK	;[26] ARE WE STEPPING?
	SKIPE	REEBRK		;[26] TIME TO BREAK?
	JRST	CTRCE3		;[26] YES
	SKIPN	PTFLG.		;ARE WE PRINTING?
	JRST	DEBCHK		;NO, SEE IF DEBUGGING THIS PROCEDURE

; WE ARE TRACING SO WE MUST PRINT

CTRCE3:	PUSHJ	PP,PTDPTH	;PRINT STRING OF !/*
	TYPE	ANGLIN
	SKIPN	T1,L.PARA	;[26] IS THERE A CURRENT PARAGRAPH?
	JRST	[SKIPN	T1,L.SECT
		JRST	[PTYPE [ASCIZ /(no name)/]
			JRST	CTRCE6]
		PUSHJ	PP,PRTPNM
		PTYPE	[ASCIZ / SECTION/]
		JRST	CTRCE6]	;[26] NO, PRINT SECTION NAME ONLY.
	PUSHJ	PP,PRTPNM	;[26] YES, PRINT PARA NAME
	SKIPN	T1,L.SECT	;[26] SECT NAME TOO?
	JRST	CTRCE6		;[26] NO
	PTYPE	[ASCIZ / in /]	;[26] YES
	PUSHJ	PP,PRTPNM	;[26] PRINT SECT NAME
CTRCE6:	TYPE	ANGLOU
	TYPE	CRLF
	SKIPN	REEBRK		; [21] FROM A REENTER OR STEP?
	JRST	DEBCHK		;NO, RETURN...
				; [21] YES, SETUP A BREAK
DEB:	MOVEM	PP,REEFLG	; [21] SET FLAGS FOR OTHERS AND SAVE STACK POINTER.
	HRRZ	T2,0(PP)	; [21] FIND RETURN ADDRESS BY
	ADD	T2,T5		; [21] ADDING ARGUMENT COUNT
	HRRM	T2,0(PP)	; [21]
	JSR	SAVE		; [21] GO SAVE THE STATE OF ALL
	SETZM	REEBRK		; [21] NEVER DO THIS TWICE
	PUSHJ	PP,REMOVB	;[27] REMOVE FOR STEP COMMAND
;;;	SETZM	PTFLG.		; [26] OR THIS NUMBER OF TIMES
	JRST	XECUTX		; [21]

;CHECKS WHETHER STEPPING IS BEING DONE AND PRINTS IF SO.

STPCHK:	SOSE	STPCTR		;[26] ARE WE STEPPING?
	POPJ	PP,		;[26] NO
	SETOM	REEBRK		;[26] YES. SET TO BREAK.
	PTYPE	[ASCIZ /STEP at /] ;[26]
	POPJ	PP,		;[26]

;COMMON ENTRANCE TO PRNAM
PRTPNM:	LDB	DT,[POINT 15,0(T1),17]	;[26] GET NAMTAB ADDR
	MOVE	T2,ACTEPA	;[46] Actual entry point
	HRRZ	T2,1(T2)	;[46] Current module's low seg data
	HRRZ	T2,%%NM.(T2)	;[46] Namtab table address
	ADD	DT,T2		;[46] Absolute address of symbol
	JRST	PRNAM
;TRACE A 'GOBACK' OR 'EXIT PROGRAM'

TRACE0:	PUSHJ	PP,	TRAC1D
	ASCIZ	/<<GOBACK>>
/

TRACE1:	PUSHJ	PP,	TRAC1D
	ASCIZ	/<<EXIT PROGRAM>>
/

TRAC1D:	SKIPE	HFGTHR		;IF WE'RE DOING A HISTOGRAM GO
	PUSHJ	PP,HAGBS	; ACCUMULATE STATISTICS.
	PUSHJ	PP,STPCHK	;[26] SEE IF WE ARE STEPPING
	SKIPE	REEBRK		;[26] SHOULD WE PRINT THE MESSAGE?
	JRST	TRAC1F		;[26] YES
	SKIPN	PTFLG.		;ARE WE TRACING?
	JRST	TRAC1H		;NO
TRAC1F:	PUSHJ	PP,PTDPTH	;PRINT STRING OF */!
	TYPE	@(PP)		;PRINT MESSAGE
TRAC1H:	AOS	DEPTH		;SHORTEN STRING
	POP	PP,0(PP)	;DISCARD POINTER TO TYPEOUT
	POP	PP,T2		;[26] SAVE TRACE EXIT
	POP	PP,CUREPA	;[26] UNSTACK ENTRY POINT
	POP	PP,T3		;[26] UNSTACK SECT AND PARA PRTAB ADDRS.
	HRRZM	T3,L.SECT	;[26] RESTORE SECTION NAME
	HLRZM	T3,L.PARA	;[26] RESTORE PARA NAME
	PUSH	PP,T2		;[26] RESTACK TRACE EXIT
	SKIPE	REEBRK		;[26] SIMULATE BREAK?
	JRST	DEB		;[26] YES
	JRST	CNPOPJ

;TRACE ENTRY OR PROGRAM-ENTRY

;CAUTION: DO NOT TAMPER WITH NEXT THREE LINES.
	XWD	0,"!"
TRACE2:	SOSL	DEPTH
	JSA	T2,TPDCHR	;ADD ! TO STRING
	SKIPE	HFGTHR		;IF WE'RE DOING A HISTOGRAM GO
	PUSHJ	PP,HAEPS	; ACCUMULATE STATISTICS.
	POP	PP,T2		;[26] SAVE TRACE EXIT
	POP	PP,T1		;[26] SAVE PTR TO PREVIOUS STACK FRAME
	PUSH	PP,L.SECT	;[26] STACK OLD SECTION NAME
	MOVE	T3,L.PARA	;[26] GET OLD PARA NAME
	HRLM	T3,0(PP)	;[26] STACK OLD PARA NAME
	PUSH	PP,CUREPA	;[26] STACK OLD ENTRY POINT
	PUSH	PP,T1		;[26] RESTACK PREV STACK FRAME'S PTR
	PUSH	PP,T2		;[26] RESTACK TRACE EXIT
;HAVE TO ADJUST THE VALUE OF THE STACK POINTER THAT PUTF. (IN LIBOL)
;SAVED IN SBPSA.  THIS ROUTINE JUST ADDS 2 TO IT.
	PUSHJ	PP,ISBPS.	;[26]
	SETZM	L.SECT		;[26] FORGET OLD
	SETZM	L.PARA		;[26]   PROCED NAMES
;NOW FIND THE ENTRY POINT BY SEARCHING BACKWARDS FROM CALL ON C.TRCE.
	MOVSI	T1,(SKIPA)	;[26] ENTRY PT HAS SKIPA 0
	CAME	T1,(T2)		;[26] THIS IT?
	SOJA	T2,.-1		;[26] NO
	HRRZM	T2,CUREPA	;[26] YES, SAVE IT
	HRRZM	T2,ACTEPA	;[46] Save as actual entry point, too
	PUSHJ	PP,STPCHK	;[26] ARE WE STEPPING?
	SKIPE	REEBRK		;[26] SIMULATE BREAK?
	JRST	TRACE3		;[26] YES, SO PRINT
	SKIPE	PTFLG.		;TRACING?
	JRST	TRACE3		;YES
	SKIPN	T2,EBRKOV	;[26] BREAK ON OVERLAY?
	JRST	CNPOPJ		;[26] NO
;(IF MODULE IN OVERLAY HAD NO SYMBOLS, WE MISSED THAT BREAK)
	CAMN	T2,CUREPA	;[26] RIGHT ENTRY POINT?
	JRST	BROV		;[26] YES
	SETZM	EBRKOV		;[26] NO,FORGET IT
CNPOPJ:	ADDM	T5,(PP)		;NO, SKIP RETURN
	POPJ	PP,

;PRINT THE PROGRAM OR ENTRY NAMES

TRACE3:	PUSHJ	PP,PTDPTH
	AOS	(PP)		;AIM AT NAME ARG
	PTYPE	ANGLIN
	TRNE	T2,TC.PE	;PROGRAM ENTRY?
	JTYPE	[ASCIZ "PROGRAM "]
	TRNE	T2,TC.AE	;OR OTHER ENTRY?
	JTYPE	[ASCIZ "ENTRY "]
TRACE5:	SOJLE	T5,TRACE4	;CHK COUNT OF NAME TO PRINT
	AOS	T2,(PP)		;BUMP ARG PTR
	MOVE	T2,-1(T2)	;GET ARG WORD
	PUSHJ	PP,SIXSIX
	JRST	TRACE5
TRACE4:	PTYPE	[BYTE (7)76,76,15,12]
	SKIPN	T2,EBRKOV	;[26] BREAK ON OVERLAY?
	JRST	TRACE6		;[26] NO
;(IF MODULE IN OVERLAY HAD NO SYMBOLS, WE MISSED THAT BREAK)
	CAMN	T2,CUREPA	;[26] RIGHT ENTRY POINT?
	JRST	BROVA		;[26] YES
TRACE6:	SETZM	EBRKOV		;[26] NO,FORGET IT
	SKIPE	REEBRK		;[26] SIMULATE BREAK?
	JRST	DEB		;[26] YES
	POPJ	PP,

;GETS NAMTAB, DATAB AND PRTAB ADDRESSES FOR CURRENT ENTRY POINT.
;CUREPA MUST HAVE ENTRY POINT ADDRESS.

GTTABS:	HRRZ	T2,CUREPA	;[26] GET ENTRY ADDRESS
	HRRZ	T2,1(T2)	;[26] ADDR OF %FILES
	HRLI	T2,%%NM.(T2)	;[26] NAMTAB ADDR
	HRR	T2,%NM		;[26]
	HRRZ	T1,%NM		;[26]
	BLT	T2,2(T1)	;[26] GET ALL 3
	POPJ	PP,		;[26]

;SEE IF DEBUGGING MODE REQUIRED

DEBCHK:	SKIPE	DIED.		;IF PROGRAM IS DEAD
	JRST	CNPOPJ		;JUST GIVE UP
	HRRZ	T2,(PP)		;GET FLAGS AGAIN
	HLRZ	T2,(T2)
	TRNN	T2,TC.DB	;DEBUGGING?
	JRST	CNPOPJ		;NO, JUST EXIT
	JRST	DBPRO.		;YES
SUBTTL	BTRAC. ENTRY POINT

;ENTER HERE FROM KILL.
BTRAC.:	SKIPN	DNRSTT		;Are we done RESET.?
	 POPJ	PP,		;No, error in RESET. code, don't
				; bother getting to DIALOG mode
	SETOM	DIED.		;WE ARE NOW DEAD
	SETZM	STPCTR		;[26] DON'T BREAK DURING PRINT
	SETZB	T5,REEBRK	;[26] ZERO ARG COUNT; NO BREAK
	PTYPE	[ASCIZ "Entering COBDDT from: "]
	SKIPN	@%DT		;[26] ANY SYMBOLS?
	JRST	[PTYPE [ASCIZ / (module with no symbols)/]
		JRST	BTRAC1]	;[26] NO...
	PUSHJ	PP,CTRCE3	;[26] PRINT WHERE WE ARE.
BTRAC1:	PUSHJ	PP,PPOT4.	;[26] AUTOMATIC TRACE BACK
	MOVEM	PP,PDL.		;[26] DON'T WIPE OUT ANY STACK
	JRST	XECUTX		;GO...


;ROUTINES TO KEEP TRACE CORRECT FOR PERFORMS.
;IN ORDER TO REMEMBER THE LAST-SEEN SECTION AND PARAGRAPH NAMES AT
;THE PERFORM STATEMENT, WE SAVE THEM ON THE STACK, THEN RESTORE THEM
;AT THE EXIT FROM THE PERFORM RANGE.
;	USE SAME REGISTERS THAT PERF. USES.
		PERFTA==10	;HOLDS ADDR OF START OF PERF RANGE.
		PERFTB==11	;HOLDS COPY OF RETURN ADDR ON STACK


;COME HERE FROM OBJECT PROGRAM DURING A PERFORM SETUP.
;SAVE PAR AND SECT NAMES AND ADD * TO STRING THAT GETS PRINTED
;IN FRONT OF ANY NAME THAT IS BEING TRACED.

;CAUTION: DO NOT TAMPER WITH THE NEXT THREE INSTRUCTIONS.
	XWD	0,"*"
TRPD.:	SOSL	DEPTH
	JSA	T2,TPDCHR	;ADD A * TO THE STRING
	SKIPE	HFGTHR		;IF WE'RE DOING A HISTOGRAM GO
	PUSHJ	PP,HAPFS	; ACCUMULATE STATISTICS.
;LEAVE PERFORM EXIT ADDRESS ON TOP OF STACK, BUT SLIP SECTION AND
;PARAGRAPH NAME PRTAB ADDRESSES JUST BELOW IT.
	POP	PP,PERFTB	;SAVE EXIT WORD.
	PUSH	PP,L.SECT	;STACK SECTION
	MOVE	T2,L.PARA	;[26] AND PARAGRAPH
	HRLM	T2,0(PP)	;[26] PRTAB ADDRESSES
	PUSH	PP,PERFTB	;RESTACK EXIT WORD.
	JRST	-1(PERFTA)	;RETURN

;COME HERE FROM OBJECT PROGRAM WHEN EXITING A PERFORM RANGE.
;REMOVES A CHAR FROM STRING AND RESTORES SECT AND PAR NAMES.

TRPOP.:	SKIPE	HFGTHR		;IF WE'RE DOING A HISTOGRAM GO
	PUSHJ	PP,HAEXS	; ACCUMULATE STATISTICS.
	AOS	DEPTH		;SHORTEN STRING
	POP	PP,T2		;UNSTACK RETURN ADDR
	POP	PP,PERFTA	;[26] UNSTACK SECTION
	HRRZM	PERFTA,L.SECT	;[26] AND PARAGRAPH
	HLRZM	PERFTA,L.PARA	;[26] PRTAB ADDRESSES
	JRST	(T2)		;RETURN
	IFNDEF MXDPTH,<MXDPTH==^D35>	;MAXIMUM DEPTH WE WILL KEEP TRACK OF.

;SUBROUTINE TO ADD A CHARACTER TO THE STRING.  ENTERED WITH THE WORLD'S
;WORST CALLING SEQUENCE:
;
;	XWD	0, "Z"		;THE CHARACTER TO BE ADDED.
;	SOSL	...		;ANY RANDOM INSTRUCTION.
;	JSA	T2,TPDCHR

TPDCHR:	Z				;CALLED VIA JSA.
	PUSH	PP,	T1		;DON'T MESS UP ANY AC'S.
	PUSH	PP,	T3
	MOVE	T1,	DEPTH
	SUBI	T1,	MXDPTH
	MOVE	T3,	TRSPTR
	AOJGE	T1,	TPDCHD
	IBP		T3
	AOJL	T1,	.-1
TPDCHD:	MOVE	T1,	-3(T2)
	IDPB	T1,	T3
	POP	PP,	T3
	POP	PP,	T1
	JRA	T2,	(T2)


;SUBROUTINE TO PRINT THE STRING OF *'S AND !'S.
PTDPTH:	PUSH	PP,	T2		;DON'T MESS UP ANY AC'S.
	MOVE	T2,	DEPTH
	SUBI	T2,	MXDPTH
	JUMPE	T2,	PTDPTP
	CAMG	T2,	[EXP	-MXDPTH]
	HRREI	T2,	-MXDPTH
	PUSH	PP,	T1
	PUSH	PP,	T3
	MOVE	T3,	TRSPTR
PTDPTL:	ILDB	T1,	T3
	TYPEAC	T1
	AOJL	T2,	PTDPTL
	POP	PP,	T3
	POP	PP,	T1
PTDPTP:	POP	PP,	T2
	POPJ	PP,


TRSPTR:	POINT	7,.+1
	BLOCK	<MXDPTH+4>/5
DEPTH:	EXP	MXDPTH
;ROUTINE TO DO INITIALIZATION ON THE FLY FOR LINK-10 OVERLAYS.
; CALLED BY PUTF. BEFORE IT SWAPS THE TABLES (EVERY ENTRY).
; ENTER WITH (16) = ENTRY POINT ADDRESS.
; ALL AC'S ARE PRESERVED.

SFOV.:	MOVEM	16,SAV16	;SAVE ENTRY POINT ADDRESS
	SKIPE	HFGTHR		;IF WE'RE DOING A HISTOGRAM GO
	PUSHJ	PP,HAOVL	; ACCUMULATE STATISTICS.

	JSR	SVALL		;GO SAVE THE AC'S.

	MOVE	T2,SAV16
	MOVE	T1,-2(T2)	;MAKE SURE WE ARE AT THE
	TRNE	T1,-1		; MAIN ENTRY POINT.
	MOVEI	T2,(T1)

	MOVE 	T1,1(T2)	;IF WE HAVE ALREADY
	SKIPGE	T3,%%NM.(T1)	; INITIALIZED THIS MODULE
	JRST	SFOVI		; LEAVE.
;WE HAVE TO INITIALIZE ANY NEW MODULES THAT WERE BROUGHT IN.

;  BUT FIRST REMOVE ANY BREAK POINTS AND ENTRY POINTS FOR MODULES THAT
;	WERE OVERLAYED.

	MOVE	NM,ETYPTS	;GET POINTER TO THE ENTRY POINT TABLE.

	SKIPN	T2,(NM)		;IS THERE ONE THERE?
SFOVB:	AOBJN	NM,.-1		;NO, LOOP.
	JUMPGE	NM,SFOVE	;IF THERE AREN'T ANY MORE, THERE
				; ARE NO ENTRY POINTS TO BE REMOVED,
				; GO ON.

	HLRZ	T2,T2		;GET PONTER TO THE OVERLAY BLOCK.
	JUMPE	T2,SFOVB	;IF IT'S RESIDENT, IGNORE IT.

	MOVE	T2,OVLKN(T2)	;GET THE MODULE'S LINK NUMBER.
	SKIPE	P1,OVLCHS	;GET THE ADDR OF THE ROOT'S
				; CONTROL SECTION.
SFOVC:	HRRZ	P1,CS.PTR(P1)	;GET THE NEXT CONTROL SECTION.
	JUMPE	P1,SFOVD	;NO MORE CONTROL SECTIONS,
				; GO REMOVE THE LINK.
	HRRZ	T1,CS.NUM(P1)	;GET THE LINK NUMBER.
	CAIE	T1,(T2)		;IS THIS THE ONE?
	JRST	SFOVC		;NO, GO LOOK AT THE NEXT ONE.
	JRST	SFOVB		;YES, DON'T REMOVE IT.

SFOVD:	HLRZ	T3,T2		;GET THE LOWEST ADDRESS IN THE
				; LINK THAT WENT AWAY.
	MOVEI	T5,[ASCIZ /
[Overlayed /]
	PUSHJ	PP,SFOVS	;GO REMOVE ANY ENTRY POINTS
				; AND BREAK POINTS THAT HAVE
				; BEEN OVERLAYED.

	SKIPE	PTFLG.
	JTYPE	[ASCIZ /with /]
	JRST	.+3
SFOVE:	SKIPE	PTFLG.
	MSG01==[ASCIZ "
[Brought in modules "]
	JTYPE	MSG01
;NOW GO THROUGH ALL THE CONTROL SECTIONS AND INITIALIZE ANY MODULES
; WHICH HAVEN'T BEEN INTIALIZED YET.

	SETOM	SUBSPR		;NOTE THAT THERE ARE SUBROUTINES
				; PRESENT.
	SKIPE	T1,OVLCHS	;GET THE ADDR OF THE ROOT'S CS.
SFOVF:	HRRZ	T1,CS.PTR(T1)	;GET THE ADDR OF THE NEXT CS.
	JUMPE	T1,SFOVH	;IF THAT'S ALL, WE'RE DONE.

	SKIPN	T4,CS.INT(T1)	;GET POINTER TO THE INTERNAL
				; TRANSFER TABLES.
	JRST	SFOVF		;IF IT DOESN'T EXIST, GO LOOK
				; AT THE NEXT CS.
	PUSH	PP,T1		;SAVE CS PTR.
SFOVG:	HRRZ	T2,(T4)		;GET THE ADDR (OF AN ENTRY PT?)
	PUSH	PP,T4		;SAVE THE POINTER.
	PUSHJ	PP,SFOVK	;GO SEE IF WE HAVE TO LINK ANYTHING.
	POP	PP,T4		;RESTORE THE POINTER.
	ADDI	T4,1		;SKIP OVER A WORD.
	AOBJN	T4,SFOVG	;IF THERE ARE MORE (ENTRY PTS.), LOOP.
	POP	PP,T1		;RESTORE CS PTR.
	JRST	SFOVF		;GO LOOK FOR MORE CONTROL SECTIONS.

SFOVH:	SKIPE	PTFLG.
	MSG02==[ASCIZ /]
/]
	JTYPE	MSG02
	MOVE	T2,AC0+T2
	SKIPE	BRKONO		;IF HE WANT'S TO BREAK,
	MOVEM	T2,EBRKOV	; REMEMBER TO DO SO LATER.

SFOVI:	HRLZI	17,AC0		;RESTORE THE AC'S.
	BLT	17,17

	POPJ	PP,		;RETURN.
;ROUTINE TO SET UP THE OVERLAY BLOCKS AND INITIALIZE
; MODULES IN A LINK-10 OVERLAY.
; ENTER WITH (T2) = ENTRY POINT ADDRESS.

SFOVK:	MOVE	NM,	ETYPTS		;GET THE POINTER TO THE ENTRY POINTS.

SFOVL:	MOVS	T1,	(T2)		;GET THE INSTRUCTION AT THE EP.
	CAIE	T1,	(<SKIPA 0,0>)	;IF IT ISN'T "SKIPA 0,0",
	POPJ	PP,			; LEAVE.

	HRRZ	T1,	-2(T2)		;MAKE SURE THAT WE ARE AT
	TRNE	T1,	-1		; THE MAIN ENTRY POINT.
	HRRZI	T2,	(T1)

	MOVE	T1,	1(T2)		;GET THE ADDR OF %FILES.
	SKIPGE		%%NM.(T1)	;IF THE MODULE HAS ALREADY BEEN
	POPJ	PP,			; INITIALIZED, LEAVE.

	MOVE	NM,	ETYPTS		;PUT THE MODULE'S MAIN ENTRY
	SKIPE		(NM)		; POINT IN THE ENTRY POINT
	AOBJN	NM,	.-1		; TABLE.
	JUMPGE	NM,	[CAIN	NM,	ETYTAB+^D100
			JRST	[PTYPE	[ASCIZ /
?Too many subroutines for COBDDT to cope with. Please combine
some of them so that there are less than 100 modules./]
				$DIE]
			MOVS	T3,	ETYPTS
			SUBI	T3,	1
			MOVSM	T3,	ETYPTS
			JRST		.+1]
	HRRZM	T2,(NM)		;PUT THE EP ADDR IN THE TABLE.
	HRRZM	NM,NMSVD	;REMEMBER WHERE WE PUT IT.

	HRROS	%%NM.(T1)	;MARK THE MODULE.
	MOVEM	T1,SVMPT	;SAVE MODULE POINTER

	SKIPN	PTFLG.		;IF WE'RE TRACING, PRINT IT'S NAME.
	JRST	SFOVM
	MOVE	T4,-1(T2)
	PUSHJ	PP,SFOVU
	TYPEC	" "
;BUILD AN OVERLAY BLOCK FOR THE MODULE.

;  FIRST FIND OUT WHICH LINK IT'S IN.

SFOVM:	MOVE	T1,	OVLCHS		;GET THE ADDR OF THE ROOT LINK'S
					; CONTROL SECTION.
SFOVN:	HRRZ	T1,	CS.PTR(T1)	;GET THE ADDR OF THE NEXT CS.
	MOVE	T4,	CS.COR(T1)	;GET BASE ADDR AND LENGTH OF
	HLRZ	T3,	T4		; THE LINK.
	ADDI	T3,	(T4)		;LAST ADDR IN THE LINK.
	CAIGE	T3,	(T2)		;IF THIS ISN'T THE ONE,
	JRST		SFOVN		; GO LOOK AT THE NEXT ONE.

;  NOW SEE IF IT WAS IN CORE BEFORE.

	MOVE	T5,	-1(T2)		;GET THE MODULE'S NAME.
	MOVE	P2,	CS.NUM(T1)	;AND LINK NUMBER.

	SKIPA	T4,	OVRLHD		;GET THE POINTER TO THE OVERLAY BLOCKS.
SFOVO:	SKIPN	T4,	OVLTN(T4)	;GET THE NEXT OVERLAY BLOCK.
	JUMPE	T4,	SFOVP		;NO MORE OVERLAY BLOCKS, IT WAS
					; NEVER IN CORE BEFORE.
	HRRZ	T3,	OVLKN(T4)	;GET THE LINK NUMBER.
	CAMN	T5,	OVNAM(T4)	;NAMES MATCH?
	CAIE	P2,	(T3)		;YES, LINK NO'S MATCH?
	JRST		SFOVO		;NO, NOT A MATCH.
	JRST		SFOVQ		;MATCH, GO ON.


;  DIDN'T FIND A MATCH, BUILD A BLOCK FOR IT.

SFOVP:	PUSH	PP,T1		;SAVE PTR TO OVERLAY
	MOVEI	T1,OVBKSZ	;# WORDS WE NEED
	PUSHJ	PP,GWORDS	;GET THE WORDS, RETURNS ADDR IN T3
	POP	PP,T1		;T1:= PTR TO OVERLAY
;  LINK THE BLOCK IN AS THE LAST BLOCK IN THE LIST.

	SKIPN	T4,OVRLHD
	HRLZI	T4,OVRLHD
	HLRZS	T4
	HRRZM	T3,(T4)		;STORE ADDRESS OF THIS BLOCK
	HRLM	T3,OVRLHD

	MOVE	T4,MYJFF	;GET NEW JBFF
	HRLI	T3,(T3)		;ZERO OUT THE BLOCK.
	SETZM	(T3)
	ADDI	T3,1
	BLT	T3,-1(T4)

	MOVEI	T4,-OVBKSZ(T4)	;POINT AT THE FIRST LOCATION OF
				; THE BLOCK.

;NOTE: T2 MUST NOT BE SMASHED BY THE ABOVE.. IT IS USED AGAIN HERE

	MOVE	T5,-1(T2)	;GET THE MODULE'S NAME
	MOVEM	T5,OVNAM(T4)	; AND PUT IT IN THE BLOCK.

	HRL	T3,CS.COR(T1)	;COMBINE THE LOWEST ADDR IN THE
	HRR	T3,P2		; LINK WITH THE LINK NUMBER AND
	MOVEM	T3,OVLKN(T4)	; PUT THEM IN THE BLOCK.

;  PUT THE REST OF THE JUNK IN THE BLOCK.

	MOVE	T1,SVMPT	;GET MODULE POINTER
	HLL	T2,-2(T2)	;GET THE MODULE'S START ADDR.
	MOVEM	T2,OVEPA(T4)	;SAVE FIRST LOC,,EP ADDR.
	HRRZ	T3,%%NM.(T1)
	MOVEM	T3,OV%NM(T4)
	MOVE	T3,%%DT.(T1)
	MOVEM	T3,OV%DT(T4)
SFOVQ:	HLLZ	T3,OV%PR(T4)
	IORB	T3,%%PR.(T1)
	MOVEM	T3,OV%PR(T4)

	HRLM	T4,@NMSVD	;PUT THE OVERLAY BLOCK'S ADDR
				; IN THE ENTRY POINT TABLE.
;  IF THE HISTOGRAM IS ACTIVE AND WE HAVEN'T SET UP A TABLE FOR THIS
;	MODULE, DO SO NOW.

	SKIPE		HFINIT
	TLNE	T3,	-1
	JRST		SFOVR

;  SET UP A HISTOGRAM TABLE.

	MOVEI	T2,(T1)		;GET THE SIZE OF PROTAB.
	MOVE	T1,%%PR.(T2)
	HLRZ	T3,%%DT.(T2)
	SUBI	T3,(T1)

	MOVEI	T1,(T3)		;GET # WORDS WE NEED
	PUSH	PP,T2		;DON'T SMASH T2 IN GWORDS
	PUSHJ	PP,GWORDS	;RETURNS START ADDR IN T3
	POP	PP,T2		;GET BACK T2

	HLRZ	T4,(NM)		;GET THE OVERLAY BLOCK'S ADDR.
	HRLM	T3,OV%PR(T4)	;PUT THE HISTAB ADDR IN IT.
	HRLM	T3,%%PR.(T2)	; AND IN %PR.

	PUSHJ	PP,HISIRP		;GO CLEAN THE TABLE UP.

SFOVR:	HRRZ	T2,	@NMSVD		;GET THE ENTRY POINT ADDR BACK.
	HLRZ	T1,	1(T2)		;GET THE LIST OF PROGRAMS CALLED.

SFOVRH:	SKIPN	T2,	(T1)		;IF THIS MODULE DOESN'T
	POPJ	PP,			; CALL ANYONE, RETURN.
	PUSH	PP,	T1		;OTHERWISE, SAVE THE PTR.
	PUSHJ	PP,	SFOVL		;GO DO THIS PROGRAM.
	POP	PP,	T1		;RESTORE THE PTR.
	AOJA	T1,	SFOVRH		;AND GO SEE IF ANYONE ELSE IS CALLED.
;ROUTINE TO REMOVE ENTRY POINTS AND BREAK POINTS FOR ROUTINES THAT
; HAVE BEEN OVERLAYED OR CANCELED.  ENTER WITH (T3) = HIGHEST ADDRESS
; KNOWN TO STILL BE PRESENT.


SFOVS:	CAML	T3,	CUREPA		;SEE IF THE CURRENT MODULE
	JRST		SFOVSB		; WENT AWAY.

	HRRZ	T4,	ETYTAB		;IT DID, MAKE THE MAIN PROGRAM
	MOVEM	T4,	CUREPA		; THE CURRENT MODULE.
	HRRZ	T4,	1(T4)
	HRLI	T4,	%%NM.(T4)
	HRRI	T4,	BNM
	BLT	T4,	BPR

SFOVSB:	MOVE	NM,	ETYPTS		;GET THE POINTER TO THE ENTRY POINTS.
	SKIPN	T4,	(NM)		;IS THERE ONE THERE?
SFOVSD:	AOBJN	NM,	.-1		;NO, IF THERE ARE MORE, LOOP.
	JUMPGE	NM,	SFOVSL		;IF THERE ARE NO MORE, GO ON.

	CAIL	T3,	(T4)		;IF THE ENTRY POINT IS ABOVE
	JRST		SFOVSD		; THE STARTING ADDRESS, DO NOTHING.

	SKIPN		PTFLG.		;IF WE AREN'T TRACING, GO ON.
	JRST		SFOVSH

	TRNE	T5,	-1		;IF THERE IS SOMETHING TO TYPE,
	JTYPE	((T5))		; TYPE IT.
	SETZ	T5,

	HLRZ	T4,T4		;POINT AT THE OVERLAY BLOCK.
	MOVE	T4,OVNAM(T4)	;GET THE NAME.
	PUSH	PP,T3		;SAVE CURRENT T3
	PUSHJ	PP,SFOVU	;GO TYPE IT OUT.
	POP	PP,T3		;RESTORE T3
	TYPEC	" "		;FOLLOWED BY A SPACE.

SFOVSH:	SETZM	(NM)		;REMOVE THE ENTRY POINT FROM THE TABLE.
	JRST	SFOVSD		;GO LOOK FOR MORE.

SFOVSL:	MOVEI	T4,	B1ADR		;POINT AT THE FIRST BREAK POINT.
SFOVSP:	SKIPE	T1,	0(T4)		;IF THERE ISN'T ANYTHING THERE
	CAIL	T3,	(T1)		; OR IT'S BELOW THE ADDRESS,
	JRST		SFOVST		; GO LOOK AT THE NEXT ONE.
	SETZM		(T4)		;OTHERWISE CLEAR THE BP.
	SETZM		1(T4)
	SETZM		2(T4)
SFOVST:	ADDI	T4,	LBA		;MOVE UP TO THE NEXT ONE.
	CAIG	T1,	BNADR		;IF THERE ARE MOVE,
	JRST		SFOVSP		; LOOP.
	POPJ	PP,			;OTHERWISE, RETURN.
;PRINT A SIXBIT WORD. WORD IS IN T4, USES T3.

SFOVU:	SETZI	T3,
	LSHC	T3,6
	ADDI	T3,40
	TYPEAC	T3
	JUMPN	T4,	SFOVU
	POPJ	PP,
;ROUTINE TO GET A FEW WORDS OF CORE
;CALL:	T1/ # WORDS WE NEED
;	PUSHJ	PP,GWORDS
;	<RETURN .+1> (UNLESS ERROR, THEN IT HALTS THE PROGRAM)
;RETURNS:	T3/ ADDR OF START

GWORDS:	SKIPN	T1		;IF 0,
	MOVEI	T1,1		;MAKE REQUEST FOR 1
	SKIPN	T3,MYJFF	;SET-UP YET?
	 JRST	GWRD1		;NO, GO GET PAGES
	ADD	T3,T1		;# WORDS WE NEED
	CAMLE	T3,MYJBRL	;HAVE ENOUGH SPACE?
	 JRST	GWRD1		;NO, GO GET NEW PAGES
	EXCH	T3,MYJFF	;RETURN OLD ADDR, SAVE JBFF FOR NEXT TIME
	POPJ	PP,		;RETURN

;HAVE TO GET SOME WORDS
GWRD1:	PUSH	PP,T1		;SAVE # WORDS WE ARE GETTING
	IORI	T1,777		;ROUND UP TO NEAREST PAGE
	ADDI	T1,1
	MOVEM	T1,FUN.C2	;STORE ARG2
	PUSH	PP,16		;SAVE AC16
	MOVEI	16,1+[5,,0
			XWD 0,FUN.C0
			XWD 0,[ASCIZ/CDB/]
			XWD 0,FUN.CS
			XWD 0,FUN.C1
			XWD 0,FUN.C2]
	MOVEI	T1,F.PAG	;FUNCTION TO GET CORE AT PAGE BOUNDARY
	MOVEM	T1,FUN.C0	;STORE FUNCTION
	SETZM	FUN.CS		;CLEAR STATUS
	SETZM	FUN.C1		;AND ADDRESS RETURNED
	PUSHJ	PP,FUNCT.##	;CALL FUNCT. ROUTINE..
	POP	PP,16		;RESTORE AC16
	POP	PP,T1		;RESTORE # WORDS WE GOT
	SKIPE	FUN.CS		;STATUS MUST BE ZERO
	 JRST	GNXPG1		;?ERROR
	HRRZ	T3,FUN.C1	;GOT IT--GET ADDRESS OF START
	MOVEM	T3,MYJFF	;COMPUTE NEXT JBFF = START ADDR
	ADDM	T1,MYJFF	;+ LENGTH OF THIS ENTRY
	IORI	T1,777		;STORE A FAKE .JBREL
	ADD	T1,T3
	MOVEM	T1,MYJBRL
	POPJ	PP,

GNXPG1:	TYPE	[ASCIZ/?Can't get memory for overlay tables
/]
	$DIE			;Abort COBDDT

;COME HERE WHEN BREAKING AFTER HAVING BROUGHT A LINK-10 OVERLAY IN.

BROV:	ADDM	T5,(PP)		;ADJUST THE RETURN ADDRESS.
BROVA:	JSR	SAVE		;GO SAVE THE WORLD.
	SKIPE	HFGTHR		;IF WE'RE DOING A HISTOGRAM, GO
	PUSHJ	PP,HAOVL	; ACCUMULATE STATISTICS.
	PUSHJ	PP,REMOVB	;REMOVE BREAK POINTS.
	TYPE	[ASCIZ "Break upon overlay load "] ;[26]
	HRL	T2,%NM		;SAVE POINTERS
	HRRI	T2,PNM
	BLT	T2,PPR
	PUSHJ	PP,GTTABS	;[26] GET NEW TABLE POINTERS
	JRST	MODH		;TELL WHAT MODS ARE IN MEMORY (JRSTS TO XECUTX)

;COME HERE TO PROCEED FROM THE ABOVE BREAK.

PROV:	SETZM	EBRKOV		;DON'T BREAK AGAIN.
	PUSHJ	PP,INSRTB	;GO INSERT BREAK POINTS.
	HRLZI	17,AC0		;RESTORE THE AC'S.
	BLT	17,17
	POPJ	PP,		;RETURN.
;ROUTINE TO REMOVE ANY BREAKPOINTS FROM LINK-10 OVERLAYS BEFORE THEY
; ARE CANCELED.
;CALLED BY CANCEL JUST BEFORE IT CALLS OVRLAY TO REMOVE THE LINK.
;ENTER WITH (T2) = PTR TO ARG WHCH POINTS TO LINK NUMBER OF LINK TO CANCEL.
;ALL AC'S ARE PRESERVED.

CNTRC.:	JSR	SVALL		;GO SAVE THE AC'S.

	MOVE	T2,@(T2)	;GET THE LINK NUMBER.
	SKIPE	T4,OVLCHS	;POINT AT THE ROOT'S CONTROL SECTION.
CNTRCB:	HRRZ	T4,CS.PTR(T4)	;POINT AT THE NEXT CONTROL SECTION.
	JUMPE	T4,CNTRCC	;IF THERE ARE NO MORE LINKS, LEAVE.
	HRRZ	T5,CS.NUM(T4)	;GET THE LINK'S NUMBER.
	CAIE	T5,(T2)		;IF THIS ISN'T THE ONE,
	JRST	CNTRCB		; GO LOOK AT THE NEXT ONE.

	PUSH	PP,T4		;SAVE LINK INFO
	HRRZ	T3,CS.COR(T4)	;GET THE LOWEST ADDRESS IN THE LINK.

	MOVEI	T5,[ASCIZ /	;PRINT THIS IF TRACING
[Canceled /]
	PUSHJ	PP,SFOVS	;GO REMOVE ANY BREAK POINTS AND
				; ENTRY POINTS IN THE CANCELED
				; ROUTINES.
	POP	PP,T4		;RESTORE LINK INFO
	SKIPE	PTFLG.		;IF WE'RE TRACING,
	JTYPEC	"]"		; TERMINATE THE STRING

	SETZM	SUBSPR		;ASSUME THAT THERE ARE NO
				; SUBROUTINES LEFT.
	MOVE	NM,ETYPTS	;GET POINTER TO ENTRY POINT TABLE.
	AOBJP	NM,CNTRCC	;IF THE MAIN ROUTINE IS THE ONLY
				; THING THERE, GO ON.
	SKIPN	(NM)		;LOOK FOR A NON ZERO ENTRY IN
	AOBJN	NM,.-1		; THE TABLE.
	JUMPGE	NM,CNTRCC	;IF WE FOUND ONE, NOTE THAT
	SETOM	SUBSPR		; THERE ARE SUBROUTINES PRESENT.

CNTRCC:	HRLZI	17,AC0		;RESTORE THE AC'S.
	BLT	17,17

	POPJ	PP,		;RETURN.


;ROUTINE TO SAVE THE AC'S - JSR SVALL -

SVALL:	Z
	MOVEM	17,	AC0+17
	HRRZI	17,	AC0
	BLT	17,	AC0+16
	MOVE	17,	AC0+17
	JRST		@SVALL
SUBTTL	HISTOGRAM FEATURE

;INITIATE A HISTOGRAM.
;HERE WHEN "HISTORY BEGIN" SEEN

HISBEG:	SKIPL	HFINIT		;IF WE HAVEN'T DONE THE
	PUSHJ	PP,HISIND	; INITIALIZATION YET, GO DO IT

;START GATHERING STATISITICS.

HISSTE:	SETOM	HFGTHR		;TURN ON THE GATHER FLAG.
	SETOM	HFGTST		;TURN ON THE INITIALIZE FLAG.

	MOVE	T1,[IOWD HPSPLN,HPSPLO]	;SET UP THE PDL.
	MOVEM	T1,HPSPDL

	JRST	PRCEDD		;AUTOMATICALY PROCEED.

;HERE WHEN "HISTORY INITIALIZE" SEEN
HISINI:	PUSHJ	PP,HISIND	;CALL ROUTINE TO SETUP TABLES
	JRST	XECUTX		;BACK FOR MORE COMMANDS

;SET UP THE TABLES.

HISIND:	SKIPE	HFTBST		;IF WE HAVE ALREADY SET THEM
	JRST	HISIRD		; UP, GO CLEAN THEM UP.

;FIGURE OUT HOW MUCH CORE WE NEED, AND GO ASK FOR IT
	SETZ	T1,		;T1= HOW MANY WORDS WE NEED
	MOVE	NM,ETYPTS	;SET UP PTR TO ENTRY POINTS
	SKIPN	T2,(NM)		;IS THERE AN ENTRY POINT THERE?
HISIN2:	AOBJN	NM,.-1		;NO, IF THERE ARE MORE, LOOP
	JUMPGE	NM,HISIN3	;IF WE ARE DONE, TRY TO GET THE CORE
	HRRZ	T2,1(T2)	;GET ADDRESS OF %FILES
	MOVE	T3,%%PR.(T2)	;PROTAB ADDRESS
	TLNE	T3,-1		;IF THIS ONE WAS SET UP BEFORE
	JRST	HISIN2		; SKIP IT
	HLRZ	T4,%%DT.(T2)	;LAST LOCATION IN PROTAB.
	SUBI	T4,(T3)		;SIZE OF PROTAB.
	ADD	T1,T4		;THIS IS HOW MANY WORDS WE'LL NEED
	AOJA	T1,HISIN2	;+1 AND LOOP

;HERE WITH # WORDS WE NEED FOR THE HISTOGRAM TABLES IN T1
HISIN3:	PUSHJ	PP,GWORDS	;GET THE WORDS
	MOVEM	T3,HSTSJF	;STORE ".JBFF"

	MOVEI	T5,HSTSJF	;T5:= ADDRESS OF ".JBFF"

HISINF:	MOVE	NM,ETYPTS	;SET UP THE POINTER TO THE ENTRY POINTS.
	SKIPN	T2,(NM)		;IS THERE AN ENTRY POINT THERE?
HISINH:	AOBJN	NM,.-1		;NO, IF THERE ARE MORE, LOOP.
	JUMPGE	NM,HISINX	;IF WE'RE DONE, GO CLEAR THE TABLES.

	HRRZ	T2,1(T2)	;ADDRESS OF %FILES.
	MOVE	T1,%%PR.(T2)	;PROTAB ADDR.
	TLNE	T1,-1		;IF THIS ONE WAS SET UP BEFORE
	JRST	HISINH		; GO DO THE NEXT ONE.
	HLRZ	T3,%%DT.(T2)	;LAST LOCATION IN PROTAB.
	SUBI	T3,(T1)		;SIZE OF PROTAB.

	HRRZ	T1,HSTSJF	;HISTAB ADDRESS.
	ADDI	T3,(T1)		;LAST LOCATION IN HISTAB.
	JRST	HISINV		;GO ON

HISINV:	HRLM	T1,%%PR.(T2)	;SAVE HISTAB ADDR.
	HRRI	T3,1(T3)	;FORM NEW .JBFF.
	HRRM	T3,HSTSJF	;SAVE IT.
	JRST	HISINH		;GO DO THE NEXT TABLE.

;HERE WHEN ALL THE TABLES HAVE BEEN ALLOCATED.
HISINX:	HRRZ	T1,%PR		;GET CURRENT PR AND GO PUT THE
	PUSHJ	PP,HISIT	; HISTOGRAM TABLE IN IT.

	HRRZI	T1,PPR		;DITTO FOR THE RUN PR.
	PUSHJ	PP,HISIT

	HRRZI	T1,BPR		;AND THE BREAK PR.
	PUSHJ	PP,HISIT

;NOW GO PUT THE HISTAB ADDRESSES IN ANY SAVED %PR'S.

	MOVE	NM,ETYPTS	;GET THE POINTER TO THE ENTRY POINTS.

	SKIPN	T2,(NM)		;IS THERE AN ENTRY POINT THERE?
HISIPD:	AOBJN	NM,.-1		;NO, IF THERE ARE MORE LOOP.
	JUMPGE	NM,HISIPE	;IF THAT'S ALL GO ON.

	PUSH	PP,NM		;SAVE THE POINTER.

	MOVE	T2,1(T2)	;ADDRESS OF %FILES.
	LDB	T1,[POINT 12,%COBVR(T2),17]
	SKIPE	C74FLG		;IN COBOL-68
	CAIGE	T1,1202		;OR IN COBOL-74 PRIOR TO 12B
	JRST	[MOVEI	T1,FIXNMA+%%PR.(T2)	;ADDRESS OF SAVED PROTAB POINTER.
		JRST	.+2]		;FIXNUM IS REALLY ONE LESS (NO %DB.)
	MOVEI	T1,FIXNUM+%%PR.(T2)	;ADDRESS OF SAVED PROTAB POINTER.
	PUSHJ	PP,HISIT	;GO CHECK IT OUT.

	POP	PP,NM		;RESTORE THE ENTRY POINT POINTER.
	JRST	HISIPD		;AND LOOP.
;NOW PUT THE HISTOGRAM TABLE ADDRESSES IN ANY LINK-10 OVERLAY BLOCKS.

HISIPE:	MOVEI	T4,OVRLHD	;GET THE ADDR OF THE LIST HEADER.
HISIPF:	SKIPN	T4,(T4)		;ARE THERE MORE?
	JRST	HISIPH		;NO, GO ON.
	MOVEI	T1,OV%PR(T4)	;POINT AT THE PROTAB WORD.
	PUSHJ	PP,HISIT	;GO PUT THE HISTAB ADDR IN IT.
	JRST	HISIPF		;GO LOOK FOR MORE.

;PUT HISTOGRAM TABLE ADDRESS IN THE LOCATION WHOSE ADDRESS IS IN T1.

HISIT:	MOVE	T3,(T1)		;GET THE PROTAB ADDR.
	TRNE	T3,-1		;IF THERE IS NO PROTAB ADDR
	TLNE	T3,-1		; OR HISTAB IS ALREADY SET UP,
	POPJ	PP,		; FORGET IT.

	MOVE	NM,ETYPTS	;SET UP THE POINTER TO THE ENTRY POINTS.

	SKIPN	T2,(NM)		;IS THERE AN ENTRY POINT THERE.
HISITD:	AOBJN	NM,.-1		;NO, IF THERE ARE MORE LOOP.
	JUMPGE	NM,CPOPJ	;MUST BE A LINK-10 OVERLAY THAT
				; WENT AWAY.
	HRRZ	T2,1(T2)	;ADDRESS OF %FILES.
	MOVE	T2,%%PR.(T2)	;HISTAB ADDR,,PROTAB ADDR
	CAIE	T3,(T2)		;IS THIS THE ONE?
	JRST	HISITD		;NO, GO LOOK AT THE NEXT ONE.
	HLLM	T2,(T1)		;YES, STASH THE HISTAB ADDR.
	POPJ	PP,		;RETURN.

HISIPH:	SETOM	HFTBST		;REMEMBER THAT WE HAVE SET UP
				; THE TABLES.
;ZERO OUT ALL OF THE TABLES.

HISIRD:	MOVE	NM,ETYPTS	;SET UP THE POINTER TO THE ENTRY POINTS.

	SKIPN	T2,(NM)		;IS THERE AN ENTRY POINT THERE?
HISIRH:	AOBJN	NM,.-1		;NO, IF THERE ARE MORE LOOP.
	JUMPGE	NM,HISIRI	;IF WE'RE DONE, GO ON.

	HRRZ	T2,1(T2)	;ADDRESS OF %FILES.
	PUSHJ	PP,HISIRP	;GO ZAP THE TABLE.

	JRST	HISIRH		;GO DO THE NEXT TABLE.

;CLEAR LINK-10 OVERLAY MODULE'S TABLES IN CASE THE MODULE ITSELF ISN'T
; CURRENTLY IN CORE.

HISIRI:	SKIPN	T4,OVRLHD	;IF THERE AREN'T ANY LINK-10
	JRST	HISIRL		; OVERLAYS GO ON.

HISIRJ:	MOVEI	T2,OV%PR-%%PR.(T4) ;POINT AT WHERE %FILES WOULD BE.
	PUSHJ	PP,HISIRP	;GO ZAP THE TABLE.
	SKIPE	T4,(T4)		;IF THERE ARE MORE,
	JRST	HISIRJ		; LOOP.


HISIRL:	SETZM	HOVCPU		;CLEAR THE OVERHEAD AND
	MOVE	T2,[XWD	HOVCPU,HOVCPU+1]	;ELAPSED TIMES.
	BLT	T2,HUNELP

	SETOM	HFINIT		;REMEMBER THAT AN INITIALIZATION
				; WAS DONE.
	POPJ	PP,		;RETURN.


;ROUTINE TO ZAP A HISTAB TABLE.
; ENTER WITH THE ADDR OF %FILES IN T2.

HISIRP:	MOVE	T1,%%PR.(T2)	;HISTOGRAM TABLE ADDRESS,,PROTAB ADDRESS.
	TLNN	T1,-1		;IS THERE A TABLE THERE?
	POPJ	PP,		;NO, LEAVE.
	HLRZ	T2,%%DT.(T2)	;LAST LOCATION IN PROTAB.
	SUBI	T2,(T1)		;GET SIZE OF PROTAB.
	HLR	T1,T1		;FORM WORD FOR BLT.
	ADDI	T1,1

	SETZM	-1(T1)		;ZERO THE FIRST WORD.
	ADDI	T2,-1(T1)	;LAST LOCATION IN HISTAB.
	BLT	T1,(T2)		;ZAP.

	POPJ	PP,		;RETURN.
;STOP GATHERING STATISTICS.

;HERE WHEN "HISTORY END" SEEN
HISSTO:	SETZM	HFGTHR		;TURN OFF THE GATHER FLAG.
	JRST	XECUTX


;COME HERE WHEN THE PROGRAM TERMINATES TO PRINT THE REPORT, IF NECESSARY.

HSRPT.:	AOSN	HFGTST		;DO WE HAVE STATISTICS THAT
				; WANT TO BE PRINTED.
	JRST	HSRPTX		;NO, RETURN.

;Wait a second. Consider the following:
; Pgm gets error in RESET. code. HFGTST was 0, so the AOSN above skips.
	SKIPN	DNRSTT		;Are we done RESET.?
	 POPJ	PP,		;No, error in RESET. code, don't
				; do a report.
	PUSHJ	PP,HISREB	;GO PRINT THE REPORT
IFN TOPS20,<
	MOVE	T1,HSTJFN	;RELEASE THE JFN
	RLJFN%
	 ERJMP	.+1		;IGNORE ERRORS
	SETZM	HSTJFN		;CLEAR JFN
>;END IFN TOPS20
HSRPTX:	SETOM	DIED.		;SO ^C^C REENTER WILL WORK
	SETOM	HFGTST		;NOTE THAT WE HAVE PRINTED THE REPORT
				; (INCASE HE REENTERS AND DOES "STOP")
	POPJ	PP,		;RETURN
;PRINT THE REPORT.

;HERE FOR "HISTORY REPORT" COMMAND EXECUTION
HISREP:	SKIPN	HFINIT		;IF AN INITIALIZATION OR A BEGIN
				; WASN'T DONE, COMPLAIN.
	 JRST [	TYPE	[ASCIZ	/
?History not initialized./]
		JRST	XECUTC]

	PUSHJ	PP,HISREB	;GO PRINT THE REPORT.
	SETOM	HFGTST		;NOTE THAT WE HAVE PRINTED THE
				; REPORT.
	JRST	XECUTX		;GO SEE IF THERE ARE MORE COMMANDS.


;CALLED BY A PUSHJ SO WE CAN CALL IT IF THE PROGRAM TERMINATES WITHOUT
; PRINTING THE REPORT.

HISREB:	MOVEM	PP,HSTPDL	;SAVE THE PDL IN CASE WE HAVE
				; AN ERROR.

	PUSHJ	PP,HISSIO	;GO SET UP THE I/O ROUTINES.

	AOS	T5,HSTRPN	;BUMP THE REPORT NUMBER.
	TYPE	([ASCIZ /
[REPORT: /])			;AND TYPE IT OUT.
	PUSHJ	PP,	PRNUM
	TYPEC	"]"
	TYPE	CRLF

	MOVEM	17,HSTACS+17	;SAVE THE AC'S.
	HRRZI	17,HSTACS
	BLT	17,HSTACS+16
	MOVE	17,HSTACS+17

	MOVE	NM,ETYPTS	;SET UP THE POINTER TO THE
				; ENTRY POINTS.
HISRED:	SKIPE	P1,(NM)		;IS THERE ONE THERE?
	PUSHJ	PP,HISPRP	;YES, GO PRINT A PAGE.
	AOBJN	NM,HISRED	;IF THERE ARE MORE MODULES, LOOP.
;PRINT OUT THE OVERHEAD FOR PERFORMS AND SUBROUTINE CALLS.

	SKIPN	T1,HOVELP	;IF THERE WASN'T ANY FORGET IT.
	JRST	HISREF
	PUSH	PP,T1		;SAVE VALUE
	MOVEI	T1,[ASCIZ	/
OVERHEAD:	ELAPSED:  /]
	PUSHJ	PP,HISPST
	POP	PP,T1		;GET TIME TO PRINT
	PUSHJ	PP,HSPRTM
	MOVEI	T1,[ASCIZ /	CPU:  /]
	PUSHJ	PP,HISPST
	MOVE	T1,HOVCPU
	PUSHJ	PP,HSPRTM

;PRINT OUT THE UNACCOUNTABLE TIME.

HISREF:	SKIPN	HUNELP		;IF THERE WASN'T ANY FORGET IT.
	JRST	HISREG
	MOVEI	T1,[ASCIZ /
UNACCOUNTED:	ELAPSED:  /]
	PUSHJ	PP,HISPST
	MOVE	T1,HUNELP
	PUSHJ	PP,HSPRTM
	MOVEI	T1,[ASCIZ /	CPU:  /]
	PUSHJ	PP,HISPST
	MOVE	T1,HUNCPU
	PUSHJ	PP,HSPRTM

HISREG:	PUSHJ	PP,HISPEL	;PRINT A CRLF

HISREH:	HRLZI	17,HSTACS	;RESTORE THE AC'S.
	BLT	17,17

HISREL:	PUSHJ	PP,HISCLO	;GO CLOSE THE CHANNEL, RETURN IT
				; AND RETURN THE CORE.

	MOVE	PP,HSTPDL	;RESTORE THE PDL.
	POPJ	PP,		;RETURN.
;ROUTINE TO PRINT THE STATISTICS FOR ONE MODULE.

HISPRP:	MOVEI	T1,[ASCIZ /

COBDDT histogram for /]
	PUSHJ	PP,HISPST

	MOVE	T4,-1(P1)	;PRINT THE MODULE'S NAME.
HSPRPD:	SETZI	T3,
	LSHC	T3,6
	JUMPE	T3,HSPRPH
	MOVEI	CH,40(T3)
	PUSHJ	PP,HISPCH
	JRST	HSPRPD

HSPRPH:	MOVEI	CH,.CHTAB
	MOVEI	T5,4		;OUTPUT FOUR TABS
	PUSHJ	PP,HISPCH
	SOJG	T5,.-1

	MOVEI	T1,[ASCIZ /REPORT:  /]
	PUSHJ	PP,HISPST

	MOVE	T2,HSTRPN
	PUSHJ	PP,HISPDC	;PRINT THE NUMBER IN T2

	PUSHJ	PP,HISPEL	;PRINT CRLF

	LDB	T5,[POINT 7,HSTTTL,6]
	JUMPE	T5,HSPRPJ	;JUMP IF NO TITLE
	MOVEI	T1,HSTTTL	;POINT TO ADDRESS OF ASCIZ TITLE
	PUSHJ	PP,HISPST
	PUSHJ	PP,HISPEL	;CRLF

HSPRPJ:	MOVEI	T1,[ASCIZ /
PROCEDURE			    ENTRIES	      CPU	ELAPSED

/]
	PUSHJ	PP,HISPST
	SETZI	CH,		;REMEMBER THAT WE HAVE JUST PRINTED THE HEADING.

	HRRZ	P1,1(P1)	;ADDRESS OF %FILES
	MOVE	T1,%%PR.(P1)	;HISTOGRAM TABLE ADDR,,PROTAB ADDR.
	TRNE	T1,-1		;[26] IS PROTAB ADDRESS 0?
	JRST	HSPRPK		;[26]
	MOVEI	T1,[ASCIZ /(no symbols for this module)
/]				;[26]
	JRST	HISPST		;[26]

;HERE WITH RH(T1) = PROTAB ADDRESS
HSPRPK:	AOBJN	T1,.+1		;SKIP THE ZERO WORDS.
	HLLZ	T3,%%DT.(P1)	;LAST LOCATION IN PROTAB.
	HRRZ	P1,%%NM.(P1)	;NAMTAB ADDR.
	ADD	P1,[POINT 6,1]	;POINTER TO TEXT.
	MOVSS	T1		;PROTAB ADDR,,HISTOGRAM TABLE ADDR.
HSPRPL:	SKIPN	P2,(T1)		;IF THERE IS NO TIME FOR THIS
	SKIPE	2(T1)		; PROCEDURE AND IT WAS NEVER
	TRNA			; ENTERED, GO ON TO THE
	JRST	HSPRPX		; NEXT ONE.

	MOVEM	T3,SVT3		;SAVE T3
	MOVSS	T1		;POINT AT PROTAB
	LDB	T2,[POINT 15,(T1),17]	;GET THE NAMTAB LINK.
	ADD	T2,P1		;POINT AT THE NAME.

	HRREI	T3,-^D32	;SET THE POSITION COUNT.

	MOVE	T4,PR.FLG(T1)	;IF THIS IS A PARAGRAPH,
	TRNE	T4,PR%SEC	; INDENT A SPACE.  IF IT'S
	 JRST	[MOVEI	CH," "		; A SECTION AND WE HAVE
		JRST	HSPRPR]		; NOT JUST PRINTED THE HEADING
	PUSHJ	PP,HISPCH	; SKIP A LINE.

HSPRPP:	ILDB	CH,T2		;GET A CHAR.
	TRNN	CH,60		;IS THIS THE END?
	 JRST	HSPRPT		;YES, GO ON.
	CAIN	CH,':'		;REPLACE COLONS BY HYPHENS.
	MOVEI	CH,'-'
	CAIN	CH,';'		; AND SEMICOLONS BY PERIODS.
	MOVEI	CH,'.'
	ADDI	CH,40		;MAKE IT ASCII.
HSPRPR:	PUSHJ	PP,HISPCH	;PRINT IT.
	AOJA	T3,HSPRPP	;BUMP POSITION AND LOOP.

HSPRPT:	MOVEI	CH," "		;PADD WITH BLANKS UNTIL
	PUSHJ	PP,HISPCH	; WE ARE AT COLUMN 33.
	AOJL	T3,.-1
	MOVE	T4,P2		;# OF TIMES ROUTINE WAS ENTERED
HSPRTV:	IDIVI	T4,^D10		;PRINT THE NUMBER OF TIMES
	PUSH	PP,T5		; THIS ROUTINE WAS ENTERED
	SKIPE	T4		;RIGHT JUSTIFIED IN AN
	SOJA	T3,HSPRTV	; 11 CHAR FIELD.
	HRREI	T4,^D10(T3)
	PUSHJ	PP,HISPCH
	SOJG	T4,.-1
HSPRTW:	POP	PP,CH
	TRO	CH,60
	PUSHJ	PP,HISPCH
	AOJLE	T3,HSPRTW

	MOVSS	T1		;POINT AT THE HISTOGRAM TABLE AGAIN.
	PUSH	PP,T1

	MOVE	T1,1(T1)	;GET THE CPU TIME FOR THE
	PUSHJ	PP,HSPRTM	; PARAGRAPH AND GO PRINT IT.

	MOVE	T1,(PP)
	MOVE	T1,2(T1)	;GET THE ELAPSED TIME FOR THE
	PUSHJ	PP,HSPRTM	; PARAGRAPH AND GO PRINT IT.

	PUSHJ	PP,HISPEL	;PRINT A <CR><LF>

	POP	PP,T1
	MOVE	T3,SVT3		;RESTORE SAVED T3
HSPRPX:	ADD	T1,[SZ.PR6,,SZ.PR6]	;BUMP UP TO THE NEXT ENTRY.
	CAMLE	T3,T1		;ARE WE PAST THE END?
	JRST	HSPRPL		;NO, GO LOOK AT THIS ENTRY.

	POPJ	PP,		;DONE WITH THIS TABLE, RETURN.
;ROUTINE TO PRINT A TIME AS HH:MM:SS.TTT, WITH LEADING ZEROS SUPPRESSED.

HSPRTM:	MOVEI	CH," "		;THROW OUT A COUPLE SPACES.
	PUSHJ	PP,HISPCH
	PUSHJ	PP,HISPCH

	IDIVI	T1,^D1000	;GET FRACTIONAL SECONDS.
	PUSH	PP,T2		;SAVE THEM.
	IDIVI	T1,^D60		;GET SECONDS.
	PUSH	PP,T2
	IDIVI	T1,^D60		;MINUTES AND HOURS.
	PUSH	PP,T2

	SETZI	T5,		;SET THE NO SIGINFICANCE FLAG.

	PUSHJ	PP,HSPRTU	;GO PRINT HOURS.
	POP	PP,T1		;GET MINUTES BACK.
	PUSHJ	PP,HSPRTU	;GO PRINT THEM.
	POP	PP,T1		;GET SECONDS BACK.
	IDIVI	T1,^D10
	TRON	T5,-1		;TURN ON SIGNIFICANCE AND GO
	TRNE	T1,-1		; PRINT A DIGIT OR A SPACE.
	MOVEI	CH,60(T1)
	PUSHJ	PP,HISPCH
	PUSHJ	PP,HSPRTR	;GO PRINT DIGITS POSITION.
	MOVEI	CH,"."		;PRINT THE DECIMAL POINT.
	PUSHJ	PP,HISPCH
	POP	PP,T1		;GET FRACTIONAL SECONDS.
	IDIVI	T1,^D100
	PUSHJ	PP,HSPRTT
	MOVEI	T1,(T2)
HSPRTO:	IDIVI	T1,^D10
	PUSHJ	PP,HSPRTS
HSPRTR:	MOVEI	T1,(T2)
HSPRTS:	TRNE	T1,-1
	TROA	T5,-1
	TRNE	T5,-1
HSPRTT:	MOVEI	CH,60(T1)
	JRST	HISPCH

HSPRTU:	PUSHJ	PP,HSPRTO
	TRNE	T5,-1
	MOVEI	CH,":"
	JRST	HISPCH
;PRINT A <CR><LF>

HISPEL:	MOVEI	CH,15
	PUSHJ	PP,HISPCH
	MOVEI	CH,12
	JRST	HISPCH


;PRINT THE ASCIZ STRING WHOSE ADDRESS IS IN RH T1.

HISPST:	HRLI	T1,(<POINT 7,0>)
HPSTRD:	ILDB	CH,T1
	JUMPE	CH,CPOPJ
	PUSHJ	PP,HISPCH
	JRST	HPSTRD


;PRINT THE DECIMAL NUMBER IN T2.

HISPDC:	IDIVI	T2,^D10
	HRLM	T3,(PP)
	SKIPE	T2
	PUSHJ	PP,HISPDC
	HLR	CH,(PP)
	TRO	CH,60
	JRST	HISPCH
SUBTTL	HISTOGRAM I/O ROUTINES.

;SET UP FOR OUTPUT.
IFE TOPS20,<
HISSIO:	SKIPN	T2,HSTDEV	;MAKE SURE WE HAVE A DEVICE
	MOVSI	T2,'TTY'	;NO, DEFAULT TO TTY
	MOVEM	T2,HSTDEV
	SKIPE	M7FLG		;7 SERIES MONITOR?
	JRST	[MOVE	T2,[%CNHXC]	;GETTAB FOR NO. OF EXTENDED CHANS
		GETTAB	T2,		;DO WE ACTUALLY HAVE ANY?
		  JRST	.+1		;NONE IF NOT IMPLEMENTED
		JUMPE	T2,.+1		;NO, USE OLD METHOD
		MOVX	T2,FO.ASC	;YES, USE EXTENDED CHANNEL
		JRST	HISEXC]
	MOVEI	T2,F.GCH	;CALL FUNCT. TO GET
	MOVEM	T2,HSTFFN	; A CHANNEL.
	MOVEI	P2,HSTFFB
	PUSHJ	PP,FUNCT.##
	SKIPE	HSTFST		;IF WE DIDN'T GET ONE, COMPLAIN.
HISNCH:	JRST	[TYPE	[ASCIZ	/
?Can't find a free channel for history report./]
		JRST	XECUTC]

	HRLZ	T2,HSTFCH		;GET THE CHANNEL NUMBER.
HISEXC:	TXO	T2,FO.PRV		;ALLOW EXTRA PRIVS IF [1,2] OR JACCT
	MOVEM	T2,HSTFB.		;STORE IN FILOP. BLOCK
	MOVS	T2,T2
	DPB	T2,[POINT 4,HISOUT,12]	;PUT IT IN  OUTPUT IN CASE PRE-7 SERIES
	DPB	T2,[POINT 4,HISGST,12]	;SAME FOR GETSTS

;GET SPACE FOR DOUBLE BUFFER FOR HISTOGRAM DEVICE

	MOVEI	T2,HSTIOS
	DEVSIZ	T2,
	  JRST	HISER0		;FAILED
	HRRZ	T2,T2		;SIZE ONLY
	LSH	T2,1		;DOUBLE BUFFERS
	MOVEM	T2,HSTSIZ	;SAVE SIZE
	MOVEI	T2,F.GOT
	MOVEM	T2,HSTFFN
	MOVEI	P2,HSTFFC	;ARG FOR FUNCT.
	PUSHJ	PP,FUNCT.
	SKIPE	HSTFST		;CHECK STATUS
	JRST	HISER0		;NOT ENUF CORE

;DO FILOP. TO APPEND TO FILE, WILL CREATE A NEW ONE IF NO OLD.

	PUSH	PP,.JBFF	;SAVE OTS VALUE
	MOVE	T2,HSTADR	;GET WHERE BUFFER WILL GO
	MOVEM	T2,.JBFF	;IF FILOP. SUCCEEDS
	MOVEI	T2,.FOAPP	;APPEND FUNCTION
	HRRM	T2,HSTFNC
	MOVE	T2,[6,,HSTFB.]
	FILOP.	T2,
	  JRST	HISER1		;FAILED, COMPLAIN.

	POP	PP,.JBFF	;GIVE IT BACK TO OTS
	JRST	HISOPT		;DO AN OUT TO ESTABLISH THE BUFFERS.

HISER0:	PTYPE	[ASCIZ /
?Not enough memory for history report buffers./]
	JRST	XECUTC

HISER1:	PTYPE	[ASCIZ /
?FILOP. append failure for /]
	PUSHJ	PP,HISPFN
	JRST	HISREL

>;END TOPS-10 CODE

IFN TOPS20,<
HISSIO:	SKIPE	HSTJFN		;GOT A JFN?
	 JRST	GOTHJF		;YES, USE IT
	MOVX	T1,GJ%SHT
	HRROI	T2,[ASCIZ /TTY:/]
	GTJFN%
	 HALT			;?CAN'T OPEN TTY:!
	MOVEM	T1,HSTJFN	;SAVE THE JFN
GOTHJF:	MOVE	T1,HSTJFN	;GET JFN TO OPEN
	MOVX	T2,7B5+OF%APP	;READY TO APPEND TO FILE
	OPENF%			;OPEN FOR APPEND..
	 ERJMP	HSTNFF		;?CAN'T OPEN FOR APPEND!
	POPJ	PP,

HSTNFF:	TYPE	[ASCIZ/?Can't open histogram file for append: /]
	JRST	LSTFRC		;TYPE WHY & RETURN
>;END TOPS20 CODE

;OUTPUT THE CHARACTER IN CH.
IFN TOPS20,<
HISPCH:	DMOVEM	T1,JSSSV1	;SAVE T1,T2
	MOVE	T1,HSTJFN	;GET JFN
	MOVE	T2,CH		;GET BYTE
	BOUT%			;WRITE TO FILE
	 ERJMP	HISPER		;OUTPUT ERROR
	DMOVE	T1,JSSSV1	;RESTORE ACS
	POPJ	PP,		;RETURN

HISPER:	TYPE	[ASCIZ/?Output failed for histogram file: /]
	PUSHJ	PP,LSTFRC	;TYPE WHY
	JRST	HISREH		;RESTORE ACS AND POPJ
>;END IFN TOPS20

IFE TOPS20,<
HISPCH:	SOSG	HSTOBF+2
	JRST	HISOPT
HISPCM:	IDPB	CH,HSTOBF+1
	POPJ	PP,

HISOPT:	SKIPE	M7FLG		;7 SERIES?
	JRST	HISOPF		;YES, USE FILOP.
	XCT	HISOUT		;OUT UUO
	  JRST	HISPCM
	XCT	HISGST		;GETSTS
HISER2:	PUSH	PP,T2		;SAVE STATUS
	TYPE	[ASCIZ	/
?Output error on /]
	PUSHJ	PP,HISPFN
	TYPE	[ASCIZ	/ status (/]
	HRLZI	T2,(T2)
	PUSHJ	PP,PROCTD
	TYPEC	")"
	JRST	HISREH		;GO RESTORE EVERYTHING AND
				; RETURN TO COMMAND INTREPRETER.

HISOPF:	PUSH	PP,T2		;NEED A FREE ACC
	MOVEI	T2,.FOOUT	;OUTPUT FUNCTION
	HRRM	T2,HSTFNC
	MOVE	T2,[1,,HSTFB.]
	FILOP.	T2,
	  JRST	HISER2		;FAILED, COMPLAIN.
	POP	PP,T2
	JRST	HISPCM
>
;ROUTINE TO CLEAN UP AFTER THE REPORT.

IFE TOPS20,<
HISCLO:	MOVEI	T2,.FOCLS	;CLOSE FUNCTION
	HRRM	T2,HSTFNC
	MOVE	T2,[6,,HSTFB.]
	FILOP.	T2,
	  JRST	HISER3		;FAILED, COMPLAIN.

	MOVEI	T2,F.ROT	;CALL FUNCT. TO RETURN
	MOVEM	T2,HSTFFN	; THE BUFFER AREA
	MOVEI	P2,HSTFFC
	PUSHJ	PP,FUNCT.

	SKIPE	M7FLG		;IF 7 SERIES
	POPJ	PP,		;WE'RE DONE

	MOVEI	T2,F.RCH	;CALL FUNCT. TO RETURN
	MOVEM	T2,HSTFFN	; THE CHANNEL
	MOVEI	P2,HSTFFB
	JRST	FUNCT.##

HISER3:	PTYPE	[ASCIZ	/
?CLOSE failed for /]
	PUSHJ	PP,HISPFN
	JRST	HISREL
>

IFN TOPS20,<
HISCLO:	HRRZ	T1,HSTJFN
	TXO	T1,CO%NRJ	;DON'T RELEASE THE JFN
	CLOSF%
	  ERJMP	.+2		;SKIP IF CLOSF FAILED
	POPJ	PP,
	TYPE	[ASCIZ/?Can't close histogram file: /]
	JRST	LSTFRC		;TYPE WHY AND RETURN
>
;ROUTINE TO TYPE OUT THE FILE SPEC.
IFE TOPS20,<
HISPFN:	MOVE	T2,HSTDEV
	PUSHJ	PP,SIXSIX
	SKIPN	T2,HSTNAM
	POPJ	PP,
	TYPEC	":"
	PUSHJ	PP,SIXSIX
	TYPEC	"."
	SKIPE	T2,HSTEXT
	PUSHJ	PP,SIXSIX
	SKIPN	T2,HSTPP
	POPJ	PP,
	TYPEC	"["
	HLRZ	T2,HSTPP	;SEE IF SFD
	JUMPE	T2,HISPSF
	PUSHJ	PP,PROCT
	TYPEC	","
	HRRZ	T2,HSTPP
	PUSHJ	PP,PROCT
	TYPEC	"]"
	POPJ	PP,

HISPSF:	HLRZ	T2,HSTPPN
	PUSHJ	PP,PROCT
	TYPEC	","
	HRRZ	T2,HSTPPN
	PUSHJ	PP,PROCT
	MOVSI	T3,-5		;MAX SFD
HISPSL:	SKIPN	T2,HSTSFD(T3)
	JRST	HISPSE		;FINISH
	TYPEC	","
	PUSHJ	PP,SIXSIX
	AOBJN	T3,HISPSL	;LOOP
HISPSE:	TYPEC	"]"
	POPJ	PP,
>;END IFE TOPS20
;PARAGRAPHS AND SECTIONS COME HERE.
;	ENTER WITH T1 CONTAINING THE PROTAB LINK.

HAPS:	PUSHJ	PP,HACAPS	;GO INITIALIZE.

	HRLI	T1,(T1)		;FORM HISTAB ADDR,, PROTAB ADDR.
	ADD	T1,@%PR

	HLRZ	T3,T1		;GET THE HISTAB ADDR.
	AOS	(T3)		;BUMP NUMBER OF TIMES ENTERED.

	MOVE	T3,PR.FLG(T1)	;GET THE PROTAB FLAGS.
	TRNN	T3,PR%SEC	;IF IT'S A SECTION,
	JRST	HAPSD		; GO ON.

; IT'S A PARAGRAPH.

	LDB	T3,[POINT 15,1(T1),17]	;GET THE SECTION LINK.
	HLR	T1,@%PR		;GET HISTAB ADDR.
	ADDI	T1,(T3)		;FORM NEW SECTION'S HISTAB ADDR.
	MOVEM	T1,HCURPS	;SAVE PARAGRAPH/SECTION.
	TRNA

; IT'S A SECTION.

HAPSD:	HLRZM	T1,HCURPS	;SAVE NEW SECTION AND CLEAR OLD PARAGRAPH.

; REINITIALIZE THE TIMES.

HARAR:
IFE TOPS20,<
	MSTIME	T1,
	MOVEM	T1,HSTELP
	SETZI	T2,
	RUNTIM	T2,
	MOVEM	T2,HSTCPU
>
IFN TOPS20,<
	MOVEI	T1,-5		;TIMES FOR ENTIRE JOB
	RUNTM%
	MOVEM	T1,HSTCPU
	MOVEM	T3,HSTELP
>

; RESTORE AC'S AND RETURN.

HARAV:	MOVE	T4,[XWD HSTACS,T1]
	BLT	T4,T4
	POPJ	PP,


;COME HERE ON A BREAKPOINT TO UPDATE THE CURRENT PARAGRAPH/SECTION.

HABP:	PUSHJ	PP,	HACAPS		;GO INITIALIZE.
	JRST		HARAV		;GO RESTORE AC'S AND RETURN.
;PERFORMS COME HERE.

HAPFS:	PUSHJ	PP,	HACAPS		;GO INITIALIZE.

	JSR		HPFEP		;GO SAVE CURRENT PARAGRAPH/SECTION.

	MOVEI	T2,	HOVRHD		;CHARGE TIME TO OVERHEAD UNTIL
	MOVEM	T2,	HCURPS		; WE SEE A PARAGRAPH OR SECTION.

	JRST		HARAR		;GO RESTORE AC'S AND RETURN.


;ENTRY POINTS COME HERE.

HAEPS:	PUSHJ	PP,	HACAPS		;GO INITIALIZE.

	JSR		HPFEP		;GO SAVE CURRENT PARAGRAPH/SECTION.

	JRST		HAEXSD		;GO CHARGE TIME TO UNACCOUNTABLE
					; UNTIL WE SEE A PARAGRAPH OR
					; SECTION.

HPFEP:	Z
	MOVE	T1,	HCURPS		;GET CURRENT PARAGRAPH/SECTION.
	CAIN	T1,	HOVRHD		;IF WE'RE CHARGING THIS TIME TO
	JRST		HARAR		; OVERHEAD, DON'T SAVE ANYTHING.

	MOVE	T2,	HPSPDL		;GET THE PUSH DOWN POINTER.
	AOBJP	T2,	.+2		;IF THERE IS ROOM FOR THIS
	MOVEM	T1,	(T2)		; PARAGRAPH/SECTION, SAVE IT.

	MOVEM	T2,	HPSPDL		;SAVE PUSH DOWN POINTER.
	JRST		@HPFEP		;RETURN.
;EXITS, EXIT PROGRAMS AND GOBACKS COME HERE.

HAGBS:
HAEXS:	PUSHJ	PP,	HACAPS		;GO INITIALIZE.

	MOVE	T2,	HPSPDL		;GET PUSH DOWN POINTER.
	JUMPL	T2,	HAEXSH		;IF WE SAVED SOMETHING, GO ON.

	SUB	T2,	[XWD 1,1]	;DECREMENT THE POINTER, BUT DON'T
HAEXSB:	MOVEM	T2,	HPSPDL		; TRY TO RESTORE ANYTHING.

HAEXSD:	MOVEI	T2,	HUNATD		;CHARGE TIME TO UNACCOUNTABLE
	MOVEM	T2,	HCURPS		; UNTIL WE SEE A PARAGRAPH OR
					; SECTION.
	JRST		HARAR		;GO RESTORE AC'S AND RETURN.

HAEXSH:	CAMN	T2,	[IOWD HPSPLN,HPSPLO]	;IF WE HAVE NOTHING
	JRST		HAEXSD			; TO RESTORE GO CHARGE
						; THIS TIME TO UNACCOUNTABLE.

HAEXSL:	POP	T2,	HCURPS		;RESTORE OLD PARAGRAPH/SECTION.
	MOVEM	T2,	HPSPDL		;SAVE THE POINTER.
	JRST		HARAR		;GO RESTORE THE AC'S AND RETURN.


;COME HERE BEFORE PROCESSING OVERLAYS.

HAOVL:	PUSHJ	PP,HACAPS	;GO INITIALIZE.
	MOVEI	T2,HOVRHD	; CHARGE TIME TO OVERHEAD UNTIL
	MOVEM	T2,HCURPS	; WE SEE A PARAGRAPH OR SECTION.
	JRST	HARAR		;GO RESTORE AC'S AND RETURN.
;INITIALIZATION ROUTINE.
;	SAVE SOME AC'S AND IF THIS IS THE FIRST TIME WE HAVE BEEN
; CALLED SINCE THE BEGIN WAS DONE SET UP THE INITIAL TIMES OTHERWISE
; INCREMENT THE TIMES FOR THE CURRENT PARAGRAPH/SECTION.

HACAPS:
IFE BIS,<
	MOVEM	T1,HSTACS
	MOVEM	T2,HSTACS+1
	MOVEM	T3,HSTACS+2
	MOVEM	T4,HSTACS+3
>
IFN BIS,<
	DMOVEM	T1,HSTACS
	DMOVEM	T3,HSTACS+2
>
IFE TOPS20,<
	MSTIME	T1,
	SETZI	T2,
	RUNTIM	T2,
>
IFN TOPS20,<
	MOVEI	T1,-5		;TIMES FOR ENTIRE JOB
	RUNTM%
	MOVE	T2,T1		;RUNTIME IN T2
	MOVE	T1,T3		;ELAPSED IN T1
>

	AOSN	HFGTST		;IF THIS IS THE FIRST TIME WE
	JRST	HACAPU		; HAVE BEEN CALLED, GO SET UP
				; THE INITIAL TIMES.

;INCREMENT THE CURRENT PARAGRAPH/SECTION'S TIMES.

	MOVE	T3,HCURPS	;GET THE HISTAB ADDRESSES.
	HLRZ	T4,T3		;T3 HAS THE SECTION.
				;T4 HAS THE PARAGRAPH.
	SUB	T2,HSTCPU
	ADDM	T2,HSTCPU
	ADDM	T2,1(T3)
	TRNE	T4,-1
	ADDM	T2,1(T4)
	SUB	T1,HSTELP
	ADDM	T1,HSTELP
	CAMGE	T1,T2		;IF THE ELAPSED TIME IS LESS
	MOVE	T1,T2		; THAN THE CPU TIME, USE THE
				; CPU TIME AS ELAPSED TIME.
				; THIS HACK IS NECESSARY
				; BECAUSE SYSTEMS WITH REAL
				; TIME CLOCKS GET CPU TIME IN
				; MS BUT ROUND MSTIME OFF TO
				; THE NEAREST 16 MS.
	ADDM	T1,2(T3)
	TRNE	T4,-1
	ADDM	T1,2(T4)
HACAPT:	MOVE	T1,HSTACS
	POPJ	PP,

;THIS IS THE FIRST TIME WE HAVE BEEN CALLED SINCE THE BEGIN WAS DONE.

HACAPU:	MOVEM	T2,HSTCPU
	MOVEM	T1,HSTELP

	MOVEI	T2,HOVRHD	;CHARGE TIME TO OVERHEAD UNTIL
	MOVEM	T2,HCURPS	; WE SEE A PARAGRAPH OR SECTION.

	JRST	HACAPT		;GO RESTORE T1 AND RETURN.
;PRINT A SIXBIT WORD
;WORD IS IN T2, USES T1.
;ENTERED WITH PUSHJ PP,SIXSIX

SIXSIX:	MOVEI	T1,0
	LSHC	T1,6
	ADDI	T1,40
	TYPEAC	T1
	JUMPN	T2,SIXSIX
	POPJ	PP,


;ROUTINE TO SETUP DT AND W2 AFTER A NAME HAS BEEN PARSED.
; IF THE PARSE ROUTINES RETURNED 0 BECAUSE CRLF WAS TYPED,
; THE SAVED DATANAME (IF ANY) IS USED.  IF A REAL DATANAME
; WAS STORED, IT IS USED FOR THIS COMMAND TOO (WITH IT'S
; SUBSCRIPTS, TOO!).
;THIS COMMAND RETURNS .+1 IF SUCCESS, ELSE JUST GOES BACK
;TO COMMAND SCANNER AND TYPES "?No last dataname"

GDTW2:	JUMPE	DT,[MOVE DT,LAST.	;GET LAST NAME
		 JUMPE	DT,NOLAST	;WAS THERE ONE?
		 MOVE	T5,[XWD SAVSUB,NSUBS] ;YES, GET SUBS TOO
		 BLT	T5,NSUBS+3
		 JRST	.+1]
	TXNE	SW,PRNMFG	;IS THIS A PROCEDURE NAME?
	 POPJ	PP,		;YES, DON'T STORE "LAST"
	MOVEM	DT,LAST.		;SAVE FOR NEXT TIME
	MOVS	T5,[XWD SAVSUB,NSUBS]	;SAVE SUBS TOO
	BLT	T5,SAVSUB+3
	MOVE	W2,DT		;COPY DT POINTER
	POPJ	PP,		;RETURN, OK
SUBTTL	COMMAND PROCESSORS -- LOCATE

LOCTYP:	PUSHJ	PP,GDTW2	;GET A VALID DT AND W2

	TXNN	SW,PRNMFG	;[26] WERE WE GIVEN A PROC NAME?
	JRST	LCTYP0		;[26] NO, DATA NAME.
	HRRZ	T2,1(W2)	;[26] YES, GET OBJECT ADDRESS OUT OF PROTAB.
	JRST	LCTYP1		;[26] PRINT IT
LCTYP0:	CAMN	W2,[-1]		;TALLY?
	 JRST	LOCTLY		;YES
	MOVEI	W1,BASEA	;[26] SET UP 'A' OPERAND
	PUSHJ	PP,SETOPN	;[26] RESOLVE ADDRESSING.
	HRRZ	T2,BASEA	;[26] GET BASE ADDRESS
	ADD	T2,INCRA	;[26] ADD ANY SUBSCRIPT INCREMENT
	HLRZ	T1,RESA		;[26] GET BIT RESIDUE
	SKIPN	T1		;[26] BIT 0?
	AOJA	T2,LCTYP1	;[26] YES, NEXT WORD ADDRESS
	CAIN	T1,^D36		;[26] IS IT 0?
	JRST	LCTYP1		;[26] YES
	MOVEI	T5,^D36		;[26] CONVERT RESIDUE TO BIT NUMBER
	SUB	T5,T1		;[26]
	PUSH	PP,T5		;SAVE DISPLACEMENT
	PUSHJ	PP,LCTYP2	;TYPE ADDRESS
	POP	PP,T5
	PTYPE	[ASCIZ /	Starting at bit /]
	PUSHJ	PP,PRNUM	;[26] PRINT IT
	JRST	XECUTC		;RETURN TO SCANNER

;LOCATE TALLY
LOCTLY:	MOVEI	T2,TALLY.##	;GET ADDRESS OF TALLY.

LCTYP1:	PUSHJ	PP,LCTYP2	;TYPE WORD
	JRST	XECUTC		;RETURN TO SCANNER

LCTYP2:	MOVEI	T3,6		;[26] ALWAYS 6 OCTAL DIGITS
	LSH	T2,^D18		;[26]
LCTYP3:	SETZ	T1,		;[26]
	LSHC	T1,3		;[26] ISOLATE OCTAL DIGIT
	ADDI	T1,60		;[26] MAKE ASCII
	TYPEAC	T1		;[26]
	SOJG	T3,LCTYP3	;[26] MORE?
	POPJ	PP,
SUBTTL	COMMAND PROCESSORS -- GO

;DESTINATION'S PROTAB ADDRESS IS IN W2.
GOXXX:	SKIPE	DIED.		;[26] ARE WE ALIVE?
	JRST	[TYPE	[ASCIZ	/?Cannot GO!/]
		JRST	XECUTC]	;[26] DEAD
	SKIPE	REEFLG		;[26] NEED TO RESET STACK?
	JRST	[MOVE	PP,REEFLG
		POP	PP,0(PP)
		SETZM	REEFLG
		JRST	GOXXX4]	;[26] YES
	SKIPE	EBRKOV		;[26] OVERLAY BREAK?
	JRST	[TYPE	[ASCIZ	/?Module/]
		JRST	GOXXX2]	;[26] YES
	SKIPE	CUR.BP		;[26] PROGRAM STARTED?
	JRST	GOXXX4		;[26] YES
	TYPE	[ASCIZ	/?Program/] ;[26] NO
GOXXX2:	TYPE	[ASCIZ	/ not Started, do STEP, then GO/]
	JRST	XECUTC		;[26]
GOXXX4:	HRRZ	T2,1(W2)	;[26]GET DESTINATION
	MOVE	T5,0(T2)	;[26] GET INSTRUCTION
	CAME	T5,[PUSHJ PP,C.TRCE] ;[26] IS IT TRACE INSTRUCTION?
	JRST	GOXXX6		;[26] NO
	HRRZ	T5,1(T2)	;[26] GET PROTAB LINK
	ADD	T5,@%PR		;[26] MAKE ADDRESS
	CAME	T5,W2		;[26] SAME ADDRESS?
	JRST	GOXXX6		;[26] NO
	PUSHJ	PP,INSRTB	;[26] SET ANY BREAKPOINTS THAT NEED IT.
	HRRZ	T2,1(W2)	;[26] REFETCH DESTINATION
	JRST	0(T2)		;[26] GO
GOXXX6:	TYPE	[ASCIZ	/?Location is not resident/]
	JRST	XECUTC		;[26] 

SUBTTL	COMMAND PROCESSORS -- DDT

;HERE WHEN "DDT <CRLF>" SEEN
IFE TOPS20,<
GODDT:	SKIPE	.JBDDT		;IS DDT LOADED?
	JRST	GODDT1		;YES

;TRY TO MERGE VMDDT

	SAVACS			;MERGE. WIPES OUT ALL ACCS
	MOVEI	T2,VMDDT
	MERGE.	T2,
	  JRST	GODDT0		;FAILED
	RSTACS
	MOVEI	T2,700000	;ASSUME DDT IS HERE
	SETDDT	T2,
GODDT1:	OUTSTR	[ASCIZ	/[Return from DDT by typing "POPJ 17,$X"]
/]				;[26]

	PUSH	PP,.JBSA	;SAVE START ADDR.
	MOVEI	T1,BADDG	; HE SHOULDN'T TRY TO RESTART NOW!
	HRRM	T1,.JBSA	;OTHERWISE HE "CANNOT PROCEED!"
	HRRZ	T2,.JBDDT	;[26] GET DDT ENTRY POINT
	PUSHJ	PP,(T2)		;[26]
	POP	PP,.JBSA	;RESTORE .JBSA
	JRST	XECUTX		;[26]

GODDT0:	RSTACS
	OUTSTR	[ASCIZ/?DDT not accessible
/]
	JRST	XECUTX

;HERE IF HE DOES A $G AFTER GOING TO DDT.
; THIS IS A COMMON ERROR.
BADDG:	OUTSTR	<[ASCIZ/?CBDCNR Cannot restart program now.
[Assuming you meant to type "POPJ 17,$X" - returning to COBDDT]
/]>
	POPJ	PP,		;RETURN TO COBDDT.

VMDDT:	SIXBIT	/SYS/
	SIXBIT	/VMDDT/
	SIXBIT	/EXE/
	EXP 	0,0,0
>

;TOPS20 CODE FOR "DDT" COMMAND ON NEXT PAGE
IFN TOPS20,<

;HERE WHEN "DDT <CRLF>" TYPED
GODDT:	TDZA	W2,W2		;HAVEN'T BEEN HERE BEFORE
GODDT0:	SETO	W2,		;BEEN HERE BEFORE
	MOVE	1,[.FHSLF,,770] ;[26] IS PAGE ACCESSIBLE?
	RPACS%
	AND	2,[EXP PA%RD!PA%EX!PA%PEX] ;[26]
	CAME	2,[EXP PA%RD!PA%EX!PA%PEX] ;[26]
	 JRST	GETDD		;NO, BUT TRY TO READ DDT IN
	MOVE	1,770000	;[26] DOES IT CONTAIN DDT?
	CAME	1,[JRST	770002]	;[26] PROBABLY, IF EQUAL.
	 JRST	NODDT		;GIVE ERROR

;DON'T LET HIM RESTART PROGRAM... HE MUST TYPE "POPJ 17,$X"
;*** NOTE: THE FOLLOWING CODE IS FOR 12B ONLY. IT MUST BE
;          REWRITTEN WHEN LIBOL IS MADE NATIVE ON THE -20 ***
	PUSH	PP,.JBSA	;SAVE START ADDR.
	MOVEI	T1,BADDG	;PLACE TO GO IF HE TYPES $G
	HRRM	T1,.JBSA	; (PREVENT A COMMON ERROR)
	HRROI	T1,[ASCIZ/[Return from DDT by typing "POPJ 17,$X"]
/]
	PSOUT%
	PUSHJ	PP,770000	;CALL DDT
	POP	PP,.JBSA	;RESTORE .JBSA
	JRST	XECUTX		;RETURN TO COMMAND SCANNER
NODDT:	HRROI	T1,[ASCIZ/?DDT not accessible
/]
	PSOUT%
	JRST	XECUTX		;RETURN TO COMMAND SCANNER

BADDG:	TYPE	<[ASCIZ/?CBDCNR Cannot restart program now.
[Assuming you meant to type "POPJ 17,$X" - returning to COBDDT]
/]>
	POPJ	PP,		;DO IT.
;HERE IF PAGE IS NOT EVEN ACCESSIBLE.  TRY TO READ DDT IN (BUT
; BE CAREFUL TO NOT ALLOW IT TO WIPE OUT EXISTING DATA!)
GETDD:	JUMPN	W2,NODDT	;IF BEEN HERE BEFORE, GIVE UP
	MOVX	T1,GJ%OLD!GJ%SHT	;GET DDT
	HRROI	T2,[ASCIZ/SYS:UDDT.EXE/]
	GTJFN%
	 ERJMP	NODDT		;NOT THERE--SAY "NOT ACCESSIBLE"
	PUSH	PP,T1		;SAVE THE JFN
	MOVEI	T1,.FHSLF	;SAVE ENTRY VECTOR INFO
	GEVEC%			; (GET% SMASHES IT)
	PUSH	PP,T2		;SAVE THE INFO
	HRR	T1,-1(PP)	;RH(T1)= JFN
	HRLI	T1,.FHSLF	;READ INTO SAME FORK
	TXO	T1,GT%NOV	;DON'T OVERLAY EXISTING PAGES!!
	GET%			;READ IN DDT
	 ERJMP	GETFAI		;FAILED
	POP	PP,T2		;ENTRY VECTOR INFO
	MOVEI	T1,.FHSLF
	SEVEC%			;RESTORE ENTRY VECTOR
	POP	PP,(PP)		;FORGET JFN, DON'T CARE ANYMORE
	DMOVE	T1,116		;GET SYMBOL TABLE INFO
	MOVEM	T1,@770001	;STORE IN DDT
	MOVEM	T2,@770002	;. .
	JRST	GODDT0		;GO TRY AGAIN

GETFAI:	POP	PP,(PP)		;FORGET ENTRY VECTOR INFO
	TYPE	[ASCIZ/?GET failed-- can't read in DDT: /]
	PUSHJ	PP,LSTFRC	;TYPE LAST ERROR IN THIS FORK
	POP	PP,T1		;RECOVER JFN
	RLJFN%
	 ERJMP	.+2		;CAN'T RELEASE JFN
	JRST	XECUTX		;GIVE UP
	TYPE	[ASCIZ/?Can't release JFN for SYS:UDDT.EXE: /]
	PUSHJ	PP,LSTFRC	;TYPE WHY!
	JRST	XECUTX
>;END IFN TOPS20
SUBTTL	COMMAND PROCESSORS -- OVERLAY

;HERE WITH W2= 0 IF "OVERLAY OFF", W2= -1 IF "OVERLAY ON"
;JUST SET SWITCH ON OR OFF.
SETOVR:	MOVEM	W2,BRKONO	;SAVE ON/OFF VALUE.
	JRST	XECUTX		;CONTINUE.

SUBTTL	COMMAND PROCESSORS -- ACCEPT + DISPLAY

;HERE WITH W1= ACCGEN OR DISPGN
;JRSTS TO XECUTX WHEN DONE
;ACCEPT/DISPLAY CODE INIT AND EXECUTION

CODGNR:	MOVE	T5,[XWD CODFST,CODFST+1]
	BLT	T5,CODLST
	SETZM	TEMPC
	SETZM	EAC
	SETZM	TEMROL
IFE BIS,<
	MOVE	LIT,[IOWD N.LIT,LITROL]
	MOVE	COD,[IOWD N.COD,CODROL]
>
IFN BIS,<
	DMOVE	LIT,[IOWD N.LIT,LITROL
		     IOWD N.COD,CODROL]
>

;IF DT = 0, NO NAME WAS GIVEN WITH COMMAND, USE SAVED NAME.
	PUSHJ	PP,GDTW2	;GET VALID DT AND W2
	CAMN	DT,[-1]		;CHECK FOR TALLY
	 JRST	DOTAL		;YES, GO HANDLE IT

	PUSH	PP,W1		;SAVE ADDRESS OF ROUTINE CALLED
	PUSHJ	PP,0(W1)	;DISPATCH TO ACCEPT OR DISPLAY

;THE ACCEPT OR DISPLAY CODE GENERATORS LOAD EXECUTABLE INSRUCTIONS
;INTO THE CODROL BLOCK AND THEN RETURN HERE.

	PUSH	COD,CPOPJ	;ADD A POPJ RETURN TO THE EXECUTABLE INSTRUCS
	PUSHJ	PP,CODROL	;CALL CODE
	POP	PP,W1		;GET BACK ADDRESS OF ROUTINE CALLED
	CAIN	W1,DISPGN	;WAS THAT A DISPLAY?
	 JRST	XECUTC		;YES, TYPE A CRLF BEFORE NEXT PROMPT
	JRST	XECUTX		;GO TO NEXT COMMAND

;SPECIAL TREATMENT FOR TALLY IN COBOL-68
DOTAL:	CAIN	W1,ACCGEN	;ACCEPT TALLY?
 	 JRST	DOTALA		;YES

;DISPLAY TALLY
	MOVE	T5,TALLY.##	;GET CONTENTS OF TALLY
	JUMPGE	T5,DOTAL0	;NEGATIVE?
	MOVEI	T1,"-"		;PRINT MINUS SIGN
	TYPEAC	T1
	MOVM	T5,T5		;MAGNITUDE
DOTAL0:	PUSHJ	PP,PRNUM	;PRINT NUMBER
	JRST	XECUTC

;ACCEPT TALLY
DOTALA:	MOVSI	T5,6005		;GET PARAMETERS FOR LIBOL ACCEPT
	MOVEI	16,T5		;GET VALUE FROM USER
	PUSHJ	PP,ACEPT.	;CALL LIBOL ACCEPT ROUTINE
	MOVEM	1,TALLY.##	;SAVE VALUE
	JRST	XECUTX

;GENERATES CODE FOR A "MOVE A TO B" WHERE "A" IS THE LITERAL TYPED
;ON THE TERMINAL AND "B" IS THE IDENTIFIER TYPED IN ACCEPT COMMAND.

ACCGEN:	MOVEI	W1,BASEB	;SET UP 'B' OPERAND
	PUSHJ	PP,SETOPN
	MOVE	T5,[XWD BASEB,BASEA]
	BLT	T5,BASAX	;MAKE 'A' = 'B'
	MOVE	T5,DTFLAG(DT)	;GET FLAGS
	MOVEI	T4,EDMODE
	TXNE	T5,DTEDIT	;EDITED?
	HRRM	T4,MODEB	;YES: SET MODE

	HRLZ	W1,SIZEB	;SET UP SIZE IN PARAM
	TLO	W1,(<1B7>)	;SKIP TO CRLF
	LDB	T5,DTCLAS	;CHECK ON CLASS
	CAIN	T5,CL.NUM	;NUMERIC?
	JRST	ACEP15		;YES:

;FIELD IS ALPHANUMERIC

	HRRZ	T5,MODEB
	CAIN	T5,D7MODE	;ASCII?
	JRST	ACEP20		;OK TO USE DIRECTLY

;FIELD IS EITHER ASCII-EDITED OR NON-ASCII ALPHANUMERIC
; SO ACCEPT INTO ASCII TEMP AND MOVE AFTER

ACEP10:	MOVE	T1,SIZEA	;GET SIZE FOR TEMP CALC
	ADDI	T1,4
	IDIVI	T1,5		;NUMBER OF WORDS
	PUSHJ	PP,GETEMP	;ALLOCATE AND RETURN ADDR
	MOVEM	T1,INCRA
	MOVE	T1,[XWD ^D36,TEMROL]
	MOVEM	T1,BASEA
	MOVEI	T1,D7MODE	;'A' IS ASCII
	MOVEM	T1,MODEA
	PUSHJ	PP,ACEP20
	TXZ	SW,FASIGN!FANUM
	JRST	MXX.		;STASH AWAY

;FIELD IS NUMERIC OR NUMERIC EDITED
; SO ACCEPT INTO AC 0,1 AND THEN MOVE TO DESTINATION

ACEP15:	MOVE	T5,MODEB	;[45] GET MODE
	CAIN	T5,FPMODE	;[45] IF COMP-1
	JRST	ACEP16		;[45] USE FLOATING POINT
	PUSHJ	PP,ACEP25
	SETZM	EAC		;AC := 0
	TXO	SW,FASIGN!FANUM
	MOVEI	T5,D2MODE	;USE 2-WORD COMP
	MOVEM	T5,MODEA
	JRST	MACX.		;STASH AWAY
;[45] FIELD IS FLOATING POINT

ACEP16:	PUSHJ	PP,ACEP24	;[45] CREATE LITERAL FOR ACCEPT CALL
	SETZM	EAC		;[45] ACCEPT INTO 0 & 1
	MOVSI	CH,(MOVEM)	;[45]
	JRST	GENOPF		;[45]

;CREATE LITERAL AND CALL FOR ALPHANUMERIC

ACEP20:	LSH	W1,6
	HLR	W1,RESA		;BYTE RESIDUE
	ROT	W1,-6
	HRR	W1,BASEA	;ADDRESS
	ADD	W1,INCRA	;INCREMENT

ACEP21:	PUSH	LIT,W1		;STORE LITERAL
	MOVSI	CH,(MOVEI 16,)
	HRR	CH,LIT		;LITERAL ADDR
	PUSH	COD,CH		;STASH CODE
	PUSH	COD,[PUSHJ	PP,ACEPT.]	;CALL ACCEPT
	POPJ	PP,

;CREATE LITERAL AND CALL FOR NUMERIC

ACEP24:	TRO	W1,1B19		;[45] FLOATING POINT FLAG
ACEP25:	TLO	W1,(<1B6>)	;NUMERIC
	MOVE	T2,DPLA
	JUMPGE	T2,ACEP26	;OK IF POSITIVE
	MOVNS	T2
	TRO	T2,40		;SET SIGN
ACEP26:	ADDI	W1,(T2)		;[45] DECIMAL PLACES
	JRST	ACEP21
;COME HERE FOR "DISPLAY" COMMAND EXECUTION.
;GENERATES CODE FOR A "MOVE A TO B" WHERE "A" IS THE IDENTIFIER TYPED IN
;THE DISPLAY COMMAND AND "B" IS THE TERMINAL.

DISPGN:	LDB	T3,DTUSAG	;GET USAGE
	JRST	@DISPDO(T3)

;DISPLAY DISPATCH TABLE

DISPDO:	EXP	DISERR		;0 - NO SUCH
	EXP	DISPD6		;[22] 1 - DISPLAY 6
	EXP	DISPD7		;2 - DISPLAY 7
	EXP	STNDRD		;3 - DISPLAY 9
	EXP	STNDRD		;4 - 1 WORD COMP
	EXP	STNDRD		;5 - 2 WORD COMP
	EXP	DISPFP		;6 - COMP-1
	EXP	STNDRD		;7 - INDEX
	EXP	STNDRD		;10 - COMP-3

;CALL MOVE GENERATOR FOR A LITTLE HELP

	; MOVE TO AN ASCII TEMP - POSSIBLY EDITED
STNDRD:	PUSHJ	PP,MXTMP.

STND2:	TLZ	W1,(<1B7>)	;CRLF AT END OF LINE
	PUSH	LIT,W1
	MOVSI	CH,(MOVEI 16,)
	HRR	CH,LIT
	PUSH	COD,CH
	PUSH	COD,[PUSHJ PP,DSPLY.]	;DISPLAY IT
	POPJ	PP,

;DISPLAY ASCII

DISPD7:	MOVEI	W1,BASEA	;SET UP 'A' OPERAND
	PUSHJ	PP,SETOPN
	TXNE	SW,FANUM	;NUMERIC?
	JRST	STNDRD		;YES: USE STANDARD

	MOVE	T5,DTFLAG(DT)
	HRRZ	W1,SIZEA	;GET CORRECT SIZE
	TXNE	T5,DTEDIT	;IF EDITED
	LDB	W1,DTESIZ	;USE EXTERNAL SIZE
	CAILE	W1,1777		;[22] WILL IT FIT IN ONE OPERATION?
	JRST	[SUBI	W1,^D1020	;[22] NO
		PUSH	PP,W1		;[22] SAVE REMAINDER
		MOVEI	W1,^D1020	;[22] SAVE THE FIRST PART
		PUSHJ	PP,.+1		;[22] DO THE FIRST PART
		MOVEI	W1,^D1020/5	;[22]
		ADDM	W1,INCRA	;[22] POINT TO SECOND PART
		POP	PP,W1		;[22] GET BACK REMAINDER
		JRST	.+1]		;[22] CONTINUE
	ROT	W1,-^D12
	HLR	W1,RESA
	ROT	W1,-6
	HRR	W1,BASEA
	ADD	W1,INCRA
	JRST	STND2
;DISPLAY SIXBIT
DISPD6:	MOVEI	W1,BASEA	;[22] SET UP 'A' OPERAND
	PUSHJ	PP,SETOPN	;[22]
	TXNE	SW,FANUM	;[22] NUMERIC?
	JRST	STNDRD		;[22] YES, USE STANDARD
	MOVE	T5,DTFLAG(DT)	;[22]
	HRRZ	W1,SIZEA	;[22] GET CORRECT SIZE
	TXNE	T5,DTEDIT	;[22] IF EDITED
	LDB	W1,DTESIZ	;[22] USE EXTERNAL SIZE
	CAILE	W1,1777		;[22] WILL IT FIT IN ONE OPERATION?
	JRST	[SUBI	W1,^D1020	;[22] NO
		PUSH	PP,W1		;[22] SAVE REMAINDER
		MOVEI	W1,^D1020	;[22] SIZE OF FIRST PART
		PUSHJ	PP,.+1		;[22] DO THE FIRST PART
		MOVEI	W1,^D1020/6	;[22]
		ADDM	W1,INCRA	;[22] POINT TO SECOND PART
		POP	PP,W1		;[22] GET BACK REMAINDER
		JRST	.+1]		;[22] CONTINUE
	ROT	W1,-^D12	;[22]
	HLR	W1,RESA		;[22]
	ROT	W1,-6		;[22]
	HRR	W1,BASEA	;[22]
	ADD	W1,INCRA	;[22]
	TLZ	W1,(<1B7>)	;[22] CRLF AT END OF LINE
	PUSH	LIT,W1		;[22]
	MOVSI	CH,(MOVEI 16,)	;[22]
	HRR	CH,LIT		;[22]
	PUSH	COD,CH		;[22]
	PUSH	COD,[PUSHJ PP,DSPL.6##]	;[22] DISPLAY IT
	POPJ	PP,		;[22]

;DISPLAY A COMP-1 FIELD

DISPFP:	MOVEI	W1,BASEA	;SET UP 'A' OPERAND
	PUSHJ	PP,SETOPN
	MOVEI	T5,4
	MOVEM	T5,EAC		;USE AC(5)
	MOVSI	CH,(MOVE)
	TXNN	SW,FASIGN	;SIGNED?
	 MOVSI	CH,(MOVM)	;NO: USE MAGNITUDE ONLY
	PUSHJ	PP,GENOPA
	PUSH	COD,[PUSHJ PP,DSP.FP]
	POPJ	PP,
;SET UP OPERAND PARAMETERS
;ENTER WITH EITHER BASEA OR BASEB IN W1 & PNTR TO 'DATAB'
;ENTRY IN DT. SUBSCRIPTING IS DONE IF NECESSARY AND 'INCRX'
;AND 'RESX' ARE UPDATED.

SETOPN:	HRRZ	T2,1(DT)	;GET ADDR OF ELEMENT
	HRRZM	T2,BASEX(W1)
	SETZM	INCRX(W1)	;CLR INCREMENT

	LDB	T5,DTUSAG	;GET USAGE
	SUBI	T5,1
	CAIN	T5,%US.IN-1	;INDEX
	MOVEI	T5,D1MODE	;YES: USE 1-WORD COMP
	MOVEM	T5,MODEX(W1)

	LDB	T5,DTRESD	;GET BYTE RESIDUE
	HRLM	T5,RESX(W1)	;AND STASH
	LDB	T5,DTDPL	;GET DECIMAL PLACES
	TRZE	T5,DTPLOC	;NEGATIVE?
	MOVNS	T5		;YES: NEGATE
	MOVEM	T5,DPLX(W1)	;AND STASH IT
	LDB	T5,DTISIZ	;USE INTERNAL SIZE
	MOVEM	T5,SIZEX(W1)

	MOVE	T4,DTFLAG(DT)	;FLAGS
	TXNN	T4,DTDEF	;MAKE SURE DEFINED
	JRST	UNDEF

	TRNN	T4,DTLKS	;LINKAGE SECTION?
	TXNE	T4,DTSUBS	;NEED SUBSCRIPTS?
	 JRST	SETOP1		;YES
	SKIPE	NSUBS
	JRST	NOSUB
	JRST	.+2
SETOP1:	PUSHJ	PP,SUBSCR	;YES: DO CHECK

	MOVE	T4,DTFLAG(DT)	;GET FLAGS BACK
	CAIN	W1,BASEA	;DOING 'A'?
	JRST	SETOP2		;YES:
;'B' OPERAND

	TXNE	T4,DTSIGN	;SIGNED?
	TXOA	SW,FBSIGN
	TXZ	SW,FBSIGN
	TXNN	T4,DTEDIT	;EDITED
	TXNN	T4,DTNUM	;NO: NUMERIC
	TXZA	SW,FBNUM
	TXO	SW,FBNUM
	POPJ	PP,		;RETURN

;'A' OPERAND

SETOP2:	TXNE	T4,DTSIGN	;SIGNED?
	TXOA	SW,FASIGN
	TXZ	SW,FASIGN
	TXNN	T4,DTEDIT	;EDITED
	TXNN	T4,DTNUM	;NO: NUMERIC
	TXZA	SW,FANUM
	TXO	SW,FANUM
	POPJ	PP,		;RETURN

;DO SUBSCRIPTING

SUBSCR:	SKIPE	NSUBS		;DO WE HAVE ANY?
	JRST	SUBSC0		;YES
	TRNN	T4,DTLKS	;IN LINKAGE SECTION?
	JRST	NEDSUB		;NO: TOUGH
SUBSC0:	MOVEM	DT,SAVDT	;SAVE DATAB PNTR
	SETZB	CH,REMAN

	HLRZ	W2,RESX(W1)	;CALC B.P. TO 1ST ELEMENT
	ROT	W2,-6		;SET UP RESIDUE
	HRR	W2,INCRX(W1)

	MOVE	T4,DTFLAG(DT)	;LINKAGE SECTION?
	TRNN	T4,DTLKS
	JRST	SUBSC2		;NO
	HLRZ	T4,DTLKP(DT)	;YES, GET LINKAGE PTR
	ADD	W2,(T4)
	SKIPE	NSUBS		;0 SUBSCRIPTS?
	JRST	SUBSC2		;NO
	MOVE	T5,W2		;YES, GET TO THE END
	JRST	SUBSC8
SUBSC2:	MOVE	T5,DTSUBW(DT)	;OCCURS AT THIS LEVEL?
	TLNE	T5,DTOCCL
	JRST	SUBSCA
	LDB	DT,[POINT 15,DTSUBW+1(DT),17]
	ADD	DT,@%DT
SUBSCA:	;GET PROPER BYTE SIZE FOR RECORD
	LDB	T3,DTUSAG	;GET USAGE
	CAIN	T3,%US.IN	;INDEX?
	MOVEI	T3,D1MODE+1	;USE COMP
	HLRZ	T2,BYPTRS-1(T3)	;SKELETON BYTE POINTER
	TRZ	T2,770077	;JUST LEAVE BYTE SIZE
	TLO	W2,(T2)		;PUT BYTE SIZE IN
SUBSC1:	LDB	T2,DTNOCC	;NUMBER OF OCCURRANCES
	SKIPG	T3,SUB0.(CH)	;[24]SUBSCRIPT POSITIVE?
	JRST	SMLSUB		;[24]NO, ERROR
	CAMLE	T3,T2		;IN BOUNDS?
	JRST	LRGSUB
	SOS	T3		;OK, DECR
	LDB	T5,DTUSAG	;GET USAGE
	XCT	SUBSIZ(T5)	;GET # OF BYTES
	IMUL	T2,T3
	ADDM	T2,REMAN	;ACCUMULATE SUM
SUBSC3:	AOS	T5,CH		;NEXT SUBSCRIPT
	LDB	T2,[POINT 15,DTSUBW+1(DT),17]
	CAML	T5,NSUBS
	JRST	SUBSC4		;NO MORE TYPED
	JUMPE	T2,TOOFEW	;TOO MANY
	HRRZ	DT,T2		;PNTR TO NEXT LEVEL
	ADD	DT,@%DT
;[D42]	JRST	SUBSC1		;LOOP
	JRST	SUBSCA		;[M42] LOOP

SUBSC4:	JUMPE	T2,SUBSC6	;ALL EVEN?
	JRST	NOTNUF		;NOT ENUF
SUBSC6:	MOVE	T4,REMAN	;GET COMPUTED OFFSET
	LDB	T5,[POINT 6,W2,11]
	MOVEI	T1,^D36
	IDIV	T1,T5		;BYTES/WORD
	IDIV	T4,T1		;NUMBER OF WORDS
	MOVE	T3,T5		;SAVE REMAINDER
	MOVE	T5,W2
	ADD	T5,T4		;CALC NEW OFS
SUBSC7:	SOJL	T3,SUBSC8	;ANY BYTES LEFT OVER?
	IBP	T5		;YES: BUMP BYTE PNTR
	JRST	SUBSC7		;LOOP

SUBSC8:	HRRZM	T5,INCRX(W1)	;STORE OFFSET
	LDB	T5,[POINT 6,T5,5]
	HRLM	T5,RESX(W1)	;AND RESIDUE
	MOVE	DT,SAVDT	;GET BACK DT PTR
	POPJ	PP,		;RETURN
;A TABLE WHICH DETERMINES SIZE OF ITEM (ALWAYS IN BYTES)

SUBSIZ:	JRST	BADBAD		;0
	PUSHJ	PP,SUBSZX	;1 SIXBIT
	PUSHJ	PP,SUBSZX	;2 ASCII
	PUSHJ	PP,SUBSZX	;3 EBCDIC
	MOVEI	T2,6		;4 1-WORD COMP
	MOVEI	T2,^D12		;5 2-WORD COMP
	MOVEI	T2,6		;6 COMP-1
	MOVEI	T2,6		;7 INDEX
	PUSHJ	PP,SUBSZC	;10 COMP-3

SUBSZX:	LDB	T2,DTESIZ	;EXTERNAL SIZE
SUBSZ1:	MOVE	T4,DTFLAG(DT)
	TXNN	T4,DTSYNL!DTSYNR!DTSYLL
	POPJ	PP,		;NO SYNCS - OK
	EXCH	T5,T2
	MOVE	T4,T5
	IDIV	T4,BYTE.W-1(T2)
	SKIPE	T5
	ADDI	T4,1
	IMUL	T4,BYTE.W-1(T2)
	EXCH	T4,T2
	MOVE	T5,T4
	POPJ	PP,

SUBSZC:	;COMP - 3
	LDB	T2,DTESIZ	;EXTERNAL SIZE
	ADDI	T2,2		;FOR SIGN AND ROUND OUT BYTE
	LSH	T2,-1		;DIVIDE BY 2
	JRST	SUBSZ1
;MOVE AN ITEM TO TEMPORARY FOR USE BY "DISPLAY"
;ENTER WITH 'DT' POINTING TO AN OPERAND.
;EXIT WITH DISPLAY LITERAL IN 'W1'

MXTMP.:	SETZM	EAC		;START AN AC(0)
	MOVEI	W1,BASEA	;SET UP 'A' OPERAND
	PUSHJ	PP,SETOPN
	MOVE	T5,[XWD BASEA,BASEB]
	BLT	T5,BASBX	;MAKE 'B' = 'A'
	MOVEI	T5,D7MODE
	MOVEM	T5,MODEB	;ASCII

	TXNE	SW,FANUM	;IS 'A' NUMERIC
	JRST	MXTMP4		;YES: TREAT SPECIAL

	MOVE	T5,DTFLAG(DT)
	TXNN	T5,DTEDIT	;EDITED FIELD?
	JRST	MXTMP1		;NO:
	LDB	T5,DTESIZ	;YES: USE EXTERNAL SIZE
	MOVEM	T5,SIZEA
	MOVEM	T5,SIZEB

;INPUT FIELD IS NON-ASCII, NON-NUMERIC

MXTMP1:	HRLZ	W2,SIZEA	;CONSTRUCT LIT IN W2
	MOVE	T1,SIZEB
	ADDI	T1,4		;GET SIZE OF 'B' IN WORDS
	IDIVI	T1,5
	PUSHJ	PP,GETEMP	;GET SOME TEMP LOCS
	MOVEM	T1,INCRB
	MOVE	T1,[XWD ^D36,TEMROL]
	MOVEM	T1,BASEB
	HRR	W2,BASEB
	ADD	W2,INCRB

	PUSHJ	PP,MXX.		;GENERATE MOVE

	TLO	W2,(<^D36B5>)	;BYTE RESIDUE
	MOVE	W1,W2		;RETURN LITERAL
	POPJ	PP,
;ITEM IS NUMERIC, AND THEREFORE MUST BE EDITED.

MXTMP4:	TXO	SW,FBSIGN!FBNUM	;'B' IS ALWAYS SIGNED ETC.
	SKIPL	DPLA		;NEGATIVE DECIMAL PLACES?
	JRST	MXTMP5		;NO:
	MOVM	T5,DPLA		;YES: 'B' IS SIZE - DEC. PL.
	ADD	T5,SIZEA
	MOVEM	T5,SIZEB
	SETZM	DPLB
	JRST	MXTMP9

MXTMP5:	MOVE	T5,SIZEA	;NEGATIVE INTEGRAL PLACES?
	SUB	T5,DPLA
	JUMPGE	T5,MXTMP6	;NO: OK
	MOVE	T5,DPLA		;YES: SIZE IS # DECIMAL PLACES
	MOVEM	T5,SIZEB
	JRST	MXTMP9

MXTMP6:	;MOVE EVERYTHING TO A TEMP TO BE SURE NUMBER IS IN CORRECT FORM
;	HRRZ	T5,MODEA	;IS ITEM DISPLAY USAGE?
;	CAIG	T5,DSMODE
;	JRST	MXTM10		;YES: DON'T MOVE TO TEMP

MXTMP9:	MOVEI	T1,D6MODE	;NO: MOVE TO TEMP
	MOVEM	T1,MODEB
	MOVE	T1,SIZEB	;CALC # OF WORDS
	ADDI	T1,5
	IDIVI	T1,6
	PUSHJ	PP,GETEMP	;GET SOME SPACE
	MOVEM	T1,INCRB
	MOVE	T1,[XWD ^D36,TEMROL]
	MOVEM	T1,BASEB

	MOVE	T1,[XWD BASEB,SAVEA]
	BLT	T1,SAVAX	;SAVE 'B' PARAMETERS
	PUSHJ	PP,MXX.		;MOVE TO TEMP
	MOVE	T1,[XWD SAVEA,BASEA]
	BLT	T1,BASAX
	MOVE	T1,[XWD SAVEA,BASEB]
	BLT	T1,BASBX
;IT IS (OR HAS BEEN CONVERTED TO) DISPLAY USAGE.

	HRRZI	W1,1(LIT)	;ADDR OF LITERAL
	HRLI	W1,(<^D36B5>)
	SETZM	BASEB		;BYTE COUNTER
	MOVEI	T2,0
	MOVE	T1,[POINT 4,T2]	;INITIALIZE
	MOVE	T3,SIZEB
	SUB	T3,DPLB
	JUMPE	T3,MXT11B	;ALL TO RIGHT IF DECIMAL

	MOVEI	CH,CODES	;PRETEND THERE IS ONE INTEGER
	CAIE	T3,1		;IS THAT TRUE?
	AOSA	BASEB		;NO: LEAVE ROOM FOR SIGN
	PUSHJ	PP,MXTM20	;YES: JAM INSERT SIGN
	MOVEI	CH,CODEM	;SET UP FOR "FLOAT SIGN"

MXTM11:	SOJLE	T3,MXT11A	;ONLY ONE LEFT?
	PUSHJ	PP,MXTM20	;NO:
	JRST	MXTM11

MXT11A:	MOVEI	CH,CODE9	;USE "9" FOR LAST INTEGRAL PLACE.
	PUSHJ	PP,MXTM20
	JRST	MXTM12

MXT11B:	MOVEI	CH,CODES	;USE INSERT SIGN
	PUSHJ	PP,MXTM20

MXTM12:	SKIPN	T3,DPLB
	JRST	MXTM13
	MOVEI	CH,CODEP	;INSERT POINT
	PUSHJ	PP,MXTM20
	MOVEI	CH,CODE9	;FINISH OFF WITH "9"'S
	PUSHJ	PP,MXTM20
	SOJG	T3,.-1

;MASK HAS BEEN CREATED FOR NUMERIC ITEM--FINISH UP.

MXTM13:	MOVEI	CH,17
	IDPB	CH,T1
	PUSH	LIT,T2

	HRLZ	W2,BASEB	;FIELD SIZE TO LITERAL
	TLO	W2,(<^D36B5+1B6>)

	MOVE	T1,BASEB
	ADDI	T1,4
	IDIVI	T1,5		;SIZE IN WORDS
	PUSHJ	PP,GETEMP	;GET SOME PLACE TO PUT IT
	MOVEM	T1,INCRB
	MOVE	T1,[XWD ^D36,TEMROL]
	MOVEM	T1,BASEB
	HRR	W2,T1		;ADDR TO LIT ALSO
	ADD	W2,INCRB

	MOVEI	T1,D7MODE	;ASCII
	MOVEM	T1,MODEB
	MOVEI	T1,MDES.	;ASSUME SIGNED
	TXNN	SW,FASIGN	;IS IT?
	MOVEI	T1,MDEU.	;NO: USE UNSIGNED ROUTINE
	PUSHJ	PP,(T1)
	MOVE	W1,W2		;RETURN LIT
	POPJ	PP,

;ROUTINE TO PUT NEXT EDIT CHAR IN WORD AND STASH LIT IF
;NECESSARY. CLEAR 'T2' AND PUT B.P. IN 'T1'.

MXTM20:	IDPB	CH,T1		;STORE AWAY
	AOS	BASEB		;KEEP COUNT
	TLNE	T1,770000	;FULL WORD?
	POPJ	PP,		;NO: JUST EXIT
	PUSH	LIT,T2		;YES: STASH LIT
	MOVEI	T2,0
	MOVE	T1,[POINT 4,T2]
	POPJ	PP,		;RE-INIT AND EXIT
;DISPATCH ROUTINES FOR MOVE GENERATORS

;MOVE THE AC'S TO SOMETHING

MACX.:	HRRZ	T5,MODEA	;CHECK MODES
	CAIE	T5,D2MODE	;ONLY LEGAL
	JRST	BADCOD
	HRRZ	T5,MODEB
	JRST	@MACX.T(T5)	;DO ROUTINE

MACX.T:	EXP	MACD.		; SIXBIT
	EXP	MACD.		; ASCII
	EXP	MACD.		; EBCDIC
	EXP	MAC1C.		; 1-WORD COMP
	EXP	MAC2C.		; 2-WORD COMP
	EXP	MACFP.		; COMP-1
	EXP	MACE.		; EDITED
	EXP	MACD.1		;COMP-3

;MOVE SOMETHING TO SOMETHING

MXX.:	HRRZ	T2,MODEA
	HRRZ	T1,MODEB	;CHECK LEGAL MODES
	CAILE	T1,EDMODE
	JRST	BADCOD
	CAILE	T2,D2MODE
	JRST	[ CAIN	T2,C3MODE
		  JRST	MDD.1	;COMP-3
		  JRST	BADCOD	]
	LSH	T2,2		;MOVT.(4*MODEA+MOBEB/2)
	ROT	T1,-1
	ADDI	T2,(T1)
	TLNE	T1,1B18		;LEFT HALT DISPATCH
	SKIPA	T3,MOVT.(T2)	;NO:
	MOVS	T3,MOVT.(T2)	;YES:
	JRST	(T3)		;GO DO ROUTINE
;TABLE OF ENTRANCE POINTS TO "MOVE" ROUTINES.

MOVT.:	XWD	MDD.,MDD.	;S-S,S-A
	XWD	MDD.,BADCOD	;S-E,S-1C
	XWD	BADCOD,BADCOD	;S-2C,S-F
	XWD	MDED.,BADCOD	;S-EDIT

	XWD	MDD.,MDD.	;A-S,A-A
	XWD	MDD.,BADCOD	;A-E,A-1C
	XWD	BADCOD,BADCOD	;A-2C,A-F
	XWD	MDED.,BADCOD	;A-EDIT

	XWD	MDD.,MDD.	;E-S,E-A
	XWD	MDD.,BADCOD	;E-E,
	XWD	BADCOD,BADCOD
	XWD	MDED.,BADCOD	;E-EDIT

	XWD	M1CD.,M1CD.	;1C-S,1C-A
	XWD	M1CD.,BADCOD	;1C-E,1C-1C
	XWD	BADCOD,BADCOD	;1C-2C,1C-FP
	XWD	BADCOD,BADCOD	;-,1C-EDIT

	XWD	M2CD.,M2CD.	;2C-S,2C-A
	XWD	M2CD.,BADCOD	;2C-E,2C-1C
	XWD	BADCOD,BADCOD	;2C-2C,2C-FP
	XWD	BADCOD,BADCOD	;-,2C-EDIT

BADCOD:	PTYPE	[ASCIZ "?Illegal MOVE args"]
	JRST	XECUTC
;GENERATE CODE TO MOVE FROM DISPLAY TO DISPLAY
;FOR UNEDITED FIELDS OF SAME SIZE
; NUMERIC DISPLAYS ALWAYS GO TO SIXBIT - TEMP FOR EDIT

MDD.:	MOVE	T5,SIZEB	;CHECK ARGS
	CAMN	T5,SIZEA	;FOR SAME SIZE AND
	TXNE	SW,FBNUM	;NON-NUMERIC RECIEVER
	JRST	MDD.E

	PUSHJ	PP,BYTE.A	;GET 'A' PARAMETER
	PUSH	LIT,T2
	PUSH	COD,LIT		;ADDR OF LITERALS
	PUSHJ	PP,BYTE.C	;GET 'B' PARAMETER
	PUSH	LIT,T2
	MOVEI	CH,(MOVEI 16,)
	HRLM	CH,0(COD)	;MOVEI 16,PARAMS
	HRRZ	T3,MODEA	;GET CORRECT ROUTINE
	HRRZ	T5,MODEB
	PUSH	COD,@GMOVET(T3)	;GET ROUTINE
	POPJ	PP,

GMOVET:	GM6(T5)		;C.D6XX
	GM7(T5)		;C.D7XX
	GM9(T5)		;C.D9XX

GM6:	PUSHJ	PP,MOVE.		;SIXBIT TO SIXBIT
	PUSHJ	PP,C.D6D7
	PUSHJ	PP,C.D6D9

GM7:	PUSHJ	PP,C.D7D6
	PUSHJ	PP,MOVE.
	PUSHJ	PP,C.D7D9

GM9:	PUSHJ	PP,C.D9D6
	PUSHJ	PP,C.D9D7
	PUSHJ	PP,MOVE.

MDD.E:	;MOVING SAME TO SAME NOW
;	CAME	T5, SIZEA	; SAME SIZE NUMERIC FIELDS?
;	JRST	MDD.1		; NO - ITEM MUST BE SCALED
;	PTYPE	[ASCIZ "? Error at MDD."]
;	JRST	XECUTC

MDD.1:	PUSHJ	PP, BYTE.A	; SAME SEQUENCE AS MDD.
	PUSH	LIT, T2
	PUSH	COD, LIT
	PUSHJ	PP, BYTE.C
	PUSH	LIT, T2

	MOVSI	CH, (MOVEI 16,)	; GET PARAMETER POINTER
	HLLM	CH, (COD)
	HRRZ	T5, (COD)	; SAVE POS IN LIT POOL
	HRRZ	T4,MODEA	;SOURCE MODE
	XCT	GDXTB(T4)	;GET PROPER ROUTINE
	HRLI	CH,(PUSHJ	PP,)
	PUSH	COD,CH		;STORE CODE

	SKIPL	T4, DPLA	; NUMBER SCALED ON LEFT OF DECIMAL POINT?
	JRST	MDD.2
	PUSH	PP,	T5		;YES, SAVE POINTER TO LITERAL POOL.
	SETZI	T5,			;THE NUMBER IS IN AC 0.
	PUSHJ	PP,	SCLE		;GO MULTIPLY THE NUMBER BY SOMETHING.
	POP	PP,	T5		;RESTORE LITERAL POOL POSITION
					; OF GD?. PARAMETERS.


MDD.2:	MOVSI	CH, (MOVEI 16,)	; NOW PUT CALL TO PD6.
	HRRI	CH, (T5)	; POINT TO ARG
	AOJ	CH,
	PUSH	COD, CH		; ADD THAT
	PUSH	COD,[PUSHJ PP,PD6.]	;ALWAYS TO 6 BIT

	MOVE	CH, SIZEA
	TXNE	SW,FASIGN
	TRO	CH,(1B6)
	DPB	CH, [POINT 12, (T5), 17]	; FIX ARG IN LITROL
	MOVE	CH, SIZEB
	TRO	CH, 4000	; FORCE LEAD BIT
	DPB	CH, [POINT 12, 1(T5), 17]	; FIX SECOND ARG
	POPJ	PP,

GDXTB:	;ROUTINE TO GET DISPLAY OR COMP-3
	MOVEI	CH,GD6.
	MOVEI	CH,GD7.
	MOVEI	CH,GD9.
	PUSHJ	PP,CBDGDX
	PUSHJ	PP,CBDGDX
	PUSHJ	PP,CBDGDX
	PUSHJ	PP,CBDGDX
	MOVEI	CH,GC3.


CBDGDX:	PTYPE	[ASCIZ/?CDBINT GDXTB error
/]
	POPJ	PP,
;MOVE A 1-WORD COMP TO A DISPLAY FIELD.

M1CD.:	MOVSI	CH,(MOVE)	;MOVE TO AN AC
	TXNN	SW,FASIGN!FBSIGN	;SIGNED?
	MOVSI	CH,(MOVM)	;NOPE!
	PUSHJ	PP,GENOPA
	SKIPL	T4,	DPLA
	JRST	MACD.		;CONVERT AND RETURN
	MOVE	T5,	EAC		;FIND OUT WHERE THE NUMBER IS.
	ADDI	T5,	1
	MOVE	CH,	SIZEB		;GET THE SIZE OF THE RESULT.
	CAIG	CH,	^D10		;IF IT'S ONE WORD, ALL IS
	JRST		M2CD.3		; WELL, GO SCALE THE NUMBER.

	SOS	CH,	T5		;ALL IS NOT WELL, THE NUMBER
	DPB	CH,	CHAC		; IS IN THE WRONG AC, MOVE
	ADD	CH,	[MOVE	1]	; IT UP ONE AC.
	PUSH	COD,	CH
	JRST		M2CD.3

;MOVE A 2-WORD COMP TO A DISPLAY FILED.

M2CD.:	TXNN	SW,FASIGN!FBSIGN	;SIGNED?
	JRST	M2CD.1		;NO: USE SPECIAL ROUTINE
IFN BIS,<
	MOVSI	CH,(DMOVE)
	PUSHJ	PP,GENOPB
>
IFE BIS,<
	MOVSI	CH,(MOVE)	;MOVE TO AC'S
	PUSHJ	PP,GENOPB
	AOS	INCRA
	MOVSI	CH,(MOVE)
	PUSHJ	PP,GENOPA
>
	JRST		M2CD.2		;GO SEE IF THE NUMBER IS SCALED.

M2CD.1:
IFN BIS,<
	MOVSI	CH,(DMOVE)
	PUSHJ	PP,GENOPB
	MOVSI	CH,(SKIPGE)
	PUSHJ	PP,GENOPB
	MOVSI	CH,(DMOVN)
	PUSHJ	PP,GENOPB
>
IFE BIS,<
	MOVE	CH,[PUSHJ PP,MAG.]	;DOUBLE-PRECISION MOVE
	PUSHJ	PP,GENPUB	;OF MAGNITUDE
>
M2CD.2:	SKIPL	T4,	DPLA		;IS THE NUMBER SCALED?
	JRST		MACD.		;NO, GO CONVERT IT.
	MOVE	T5,	EAC		;FIND OUT WHERE IT WILL BE.
M2CD.3:	PUSHJ	PP,	SCLE		;GO GENERATE CODE TO SCALE IT.
	JRST		MACD.		;GO CONVERT IT.
;GENERATE CODE TO SCALE THE NUMBER IN THE AC WHOSE NUMBER IS IN T5 BY
; THE POWER OF 10 WHOSE NEGATIVE IS IN T4.

SCLE:	MOVMS		T4		;MAKE THE POWER POSITIVE.

	CAILE	T4,	^D10		;IF IT'S TWO WORDS,
	JRST		SCLEH		; GO ON.

	MOVEI	CH,	STENS(T4)	;SELECT THE APPROPRIATE NUMBER.
	DPB	T5,	CHAC		;SET UP THE AC FIELD.

	MOVE	T5,	SIZEA		;SEE WHAT THE SIZE OF THE NUMBER
					; BEFORE THE MULTIPLICATION IS.

	CAILE	T5,	^D10		;IF IT'S TWO WORDS,
	JRST		SCLED		; GO ON.

	MOVE	T5,	SIZEB		;SEE WHAT THE SIZE OF THE NUMBER
					; WILL BE AFTER THE MULTIPLICATION.
	CAILE	T5,	^D10		;IF IT'S GOING TO BE TWO WORDS
	TLOA	CH,	(MUL)		; USE MUL, OTHERWISE USE IMUL SO
	TLO	CH,	(IMUL)		; THAT WE KEEP THE RESULT IN THE
					; SAME AC.

	PUSH	COD,	CH		;STASH THE INSTRUCTION.

	POPJ	PP,			;AND RETURN.

;THE NUMBER IS DOUBLE PRECISION.

SCLED:	PUSHJ	PP,	SCLEL		;GO SAVE THE PARAMETER.
	PUSH	COD,	[PUSHJ	PP, MUL.21##]
	POPJ	PP,

;THE POWER IS DOUBLE PRECISION.

SCLEH:	MOVEI	CH,	-^D11(T4)	;CONSTRUCT THE PARAMETER.
	LSH	CH,	1
	MOVEI	CH,	DTENS(CH)
	DPB	T5,	CHAC

	PUSHJ	PP,	SCLEL		;GOSAVE IT.
	PUSH	COD,	[PUSHJ	PP, MUL.12##]
	POPJ	PP,
SCLEL:	PUSH	LIT,	CH
	HRRI	CH,	(LIT)
	HRLI	CH,	(<MOVE	16,0>)
	PUSH	COD,	CH
	POPJ	PP,

STENS:	DEC	1
	DEC	10
	DEC	100
	DEC	1000
	DEC	10000
	DEC	100000
	DEC	1000000
	DEC	10000000
	DEC	100000000
	DEC	1000000000
	DEC	10000000000


DTENS:	OCT	2			;11
	OCT	351035564000
	OCT	35			;12
	OCT	032451210000
	OCT	443			;13
	OCT	011634520000
	OCT	5536			;14
	OCT	142036440000
	OCT	70657			;15
	OCT	324461500000
	OCT	1070336			;16
	OCT	115760200000
	OCT	13064257		;17
	OCT	013542400000
	OCT	157013326		;18
	OCT	164731000000
;GENERATE CODE TO MOVE ACCUMULATORS TO A DISPLAY FIELD.

MACD.:	MOVE	T5,DTFLAG(DT)	;FLAGS
	TXNE	T5,DTBWZ	;BLANK WHEN ZERO?
	JRST	MACE.		;YES: USE EDIT

MACD.1:	HLRZ	T2,RESB		;GENERATE 'B' PARAMETER
	LSH	T2,^D12
	ADD	T2,SIZEB
	TXNE	SW,FBSIGN	;SIGNED
	TRO	T2,(<1B6>)	;YES:
	HRLZS	T2
	HRR	T2,BASEB	;EFFECTIVE ADDR
	ADD	T2,INCRB
	PUSH	LIT,T2
	MOVEI	CH,(LIT)	;ADDR OF LIT
	MOVE	T5,SIZEB	;1 OR 2 WORD COMP
	MOVE	T4,EAC
	CAIG	T5,^D10		;?
	ADDI	T4,1
	DPB	T4,CHAC		;PLAC AC FIELD
	PUSH	LIT,CH		;SAVE PARAMETER WORD
	MOVEI	CH,(LIT)	;GET ITS ADDRESS
	HRLI	CH,(MOVE 16,)	;ADD IN MOVE 16,
	PUSH	COD,CH		;SAVE CODE
	HRRZ	T5,MODEB	;GET OUTPUT MODE
	XCT	MACDRU(T5)	;GET PROPER ROUTINE
	HRLI	CH,(PUSHJ PP,)	;CHANGE TO PUSHJ
	PUSH	COD,CH		;STASH CODE
	POPJ	PP,

MACDRU:	;AC'S TO DISPLAY OR COMP-3 ROUTINES
	MOVEI	CH,PD6.
	MOVEI	CH,PD7.
	MOVEI	CH,PD9.
	PUSHJ	PP,CDTMAC
	PUSHJ	PP,CDTMAC
	PUSHJ	PP,CDTMAC
	PUSHJ	PP,CDTMAC
	MOVEI	CH,PC3.		;COMP-3

CDTMAC:	PTYPE	[ASCIZ "?CBDINT MACD.1 error
"]
	POPJ	PP,

;GENERATE CODE TO MOVE AC'S TO A 1-WORD COMP OR INDEX.

MAC1C.:	MOVSI	CH,(MOVEM)
	TXNN	SW,FBSIGN	;SIGNED?
	MOVSI	CH,(MOVMM)	;NO:
	JRST	GENOPD

;GENERATE CODE TO MOVE AC'S TO A 2-WORD COMP.

MAC2C.:	TXNN	SW,FBSIGN	;SIGNED?
	JRST	MAC2C3		;NO: USE MAGNITUDE
MAC2C2:
IFN BIS,<
	MOVSI	CH,(DMOVEM)
	JRST	GENOPE
>
IFE BIS,<
	MOVSI	CH,(MOVEM)
	PUSHJ	PP,GENOPE
	MOVSI	CH,(MOVEM)
	AOS	INCRB
	JRST	GENOPD
>
;HERE FOR POSSIBLE UNSIGNED MOVE

MAC2C3:	TXNN	SW,FASIGN	;'A' SIGNED?
	JRST	MAC2C2		;NO - OK TO USE MOVE(S)
IFN BIS,<
	MOVSI	CH,(SKIPGE)
	HRR	CH,EAC
	PUSH	COD,CH
	MOVSI	CH,(DMOVN)
	HRR	CH,EAC
	DPB	CH,CHAC
	PUSH	COD,CH
>
IFE BIS,<
	HRRZ	CH,EAC
	DPB	CH,CHAC
	PUSH	LIT,CH
	MOVEI	CH,(LIT)
	HRLI	CH,(MOVE 16,)
	PUSH	COD,CH
	PUSH	COD,[PUSHJ PP,MAG.]
>
	SETZM	EAC
	JRST	MAC2C2

;GENERATE CODE TO MOVE AC'S TO COMP-1

MACFP.:	;CONVERT TO COMP-1
	HRRZ	CH,EAC
	DPB	CH,CHAC
	PUSH	LIT,CH
	MOVEI	CH,(LIT)	;GET ADDRESS
	HRLI	CH,(MOVE 16,)
	PUSH	COD,CH
	PUSH	COD,[PUSHJ PP,FLOT.2]
	SOS	EAC		;RESULT IN C(EAC)
	MOVEI	T5,FPMODE
	MOVEM	T5,MODEA
	JRST	MAC1C.

;GENERATE CODE TO MOVE AC'S TO EDITED FIELD.

MACE.:	MOVE	T1,[XWD BASEB,SAVMB]
	BLT	T1,SVMBX	;SAVE 'B' PARAMETERS
	MOVEI	T1,D6MODE	;SET MODE TO SIXBIT
	MOVEM	T1,MODEB
	MOVE	T1,SIZEB	;GET A TEMP LOC
	ADDI	T1,5
	IDIVI	T1,6
	PUSHJ	PP,GETEMP
	MOVEM	T1,INCRB
	MOVE	T1,[XWD ^D36,TEMROL]
	MOVEM	T1,BASEB
	MOVE	T1,[XWD BASEB,SAVMA]
	BLT	T1,SVMAX	;SAVE AS 'A' PARAMETER
	PUSHJ	PP,MACD.1	;MOVE TO DISPLAY FIELD
	MOVE	T1,[XWD SAVMA,BASEA]
	BLT	T1,BASBX	;GET BACK 'A' AND 'B'
	JRST	MDED.		;DO EDIT AND RETURN
;GENERATE CODE TO MOVE A DISPLAY FIELD TO AN EDITED FIELD.

MDED.:	;FIX UP MODEB IF NECESSARY
	MOVE	T5,MODEB
	CAIE	T5,EDMODE
	JRST	MDED.0		;OK
	LDB	T5,DTUSAG	;GET REAL USAGE
	SUBI	T5,1		;NORMALIZE
	CAIN	T5,%US.IN-1	;INDEX??
	MOVEI	T5,D1MODE	;USE COMP
	MOVEM	T5,MODEB	;AND STORE IT
MDED.0:	PUSHJ	PP,BMASK	;GET EDIT MASK
	TXNE	SW,FASIGN	;ANY SIGNS
	TXNN	SW,FBSIGN
	JRST	MDEU.		;NO: USE UNSIGNED ROUTINE

;BOTH FILEDS ARE SIGNED

MDES.:	MOVE	T5,[XWD BASEA,SAVMA]
	BLT	T5,SVMAX	;SAVE 'A'
	MOVE	T5,SIZEA
	SUBI	T5,1
	PUSHJ	PP,M.IA		;FIND SIGN
	HRRZ	T5,MODEA
	HRLZ	T5,BYTE.S(T5)
	MOVNS	T5
	ADDM	T5,RESA		;MESS PARAM
	PUSHJ	PP,MBYTEA	;GET FIRST LITERAL
	PUSH	COD,LIT

	MOVE	T5,[XWD SAVMA,BASEA]
	BLT	T5,BASAX	;GET 'A' BACK
	MOVE	CH,[PUSHJ PP,EDIT.S##]
	JRST	MDEU.2		;STASH CODE AND EXIT

;GENERATE CODE FOR AN UNSIGNED EDITED FIELD.

MDEU.:	MOVE	CH,[PUSHJ	PP,EDIT.U##]
	MOVEI	T5,1(LIT)	;ADDR OF LIT
	PUSH	COD,T5

MDEU.2:	MOVEI	T5,(MOVEI 16,)
	HRLM	T5,0(COD)
	PUSH	COD,CH		;AND PUSHJ
	PUSHJ	PP,MBYTEA	;GET A BYTE POINTER
	HRRZ	T5,MODEB
	MOVE	T2,BYTE.S(T5)
	LSH	T2,6
	MOVE	T5,DTFLAG(DT)	;GET FLAGS
	TXNE	T5,DTBWZ	;BLANK WHEN ZERO?
	IORI	T2,40		;YES: SET BIT 12
	ROT	T2,-^D12
	HLR	T2,RESB
	ROT	T2,-6		;FORM B.P.
	HRR	T2,BASEB
	ADD	T2,INCRB
	PUSH	LIT,T2		;SASH AWAY
	PUSH	COD,W1		;ALSO XWD LITERAL
	POPJ	PP,		;AND EXIT
;CREATE THE MASK FOR THE "B" FIELD.

BMASK:	HRRZI	W1,1(LIT)	;LOC OF LITERAL
	HRLI	W1,(<^D36B5>)
	MOVE	T3,DTFLAG(DT)	;GET FLAGS
	TXNN	T3,DTEDIT	;EDITED
	JRST	BMASK4		;NO: BWZ THEN

	HRRZ	T3,DT		;FORM BYTEPNTRS
	ADD	T3,[POINT 4,DTBP,11]
	LDB	T4,[POINT 12,DTBP(DT),11]
	DPB	T4,[POINT 12,W1,17]	;SIGN CHARS

	MOVEI	T4,0		;INIT REPEAT COUNT
BMASK1:	MOVEI	T2,0
	MOVE	T1,[POINT 4,T2]
BMASK2:	ILDB	T5,T3
	CAIN	T5,16		;REPEAT??
	JRST	BMSK2B		;YES
BMSK2A:	IDPB	T5,T1		;STORE BYTE
	CAIN	T5,17		;END?
	JRST	BMASK3		;YES:
	TLNN	T1,770000	;WORD FULL?
	JRST	BMSK2C		;YES - SAVE LITERAL
BMSK2D:	SOJLE	T4,BMASK2	;GO TO TOP IF NOTHING TO REPEAT
	JRST	BMSK2A		;USE BYTE AGAIN

BMSK2C:	PUSH	LIT,T2		;YES: STASH
	MOVEI	T2,0		;INIT LITERAL BUFFER
	MOVE	T1,[POINT 4,T2]	;AND POINTER
	JRST	BMSK2D		;AND CONTINUE

; REPEAT
;	THE CODE IS FOLLOWED BY A COUNT OF THE NUMBER
;	OF 4 BIT BYTES WHICH FOLLOW THE COUNT AND CONTAIN THE
;	NUMBER OF REPEATS IN BINARY.  THE BYTE FOLLOWING THE
;	NUMBER OF REPEATS IS THE CHARACTER TO BE REPEATED.

BMSK2B:
	PUSH	PP,T2		;SAVE A FEW REGS
	PUSH	PP,T1
	ILDB	T4,T3		;GET NUMBER OF BYTES HOLDING FACTOR
	LSH	T4,2		;COMPUTE BITS RIGHT
	MOVE	T5,[POINT 4,T4]	;RESULT POINTER
	DPB	T4,[POINT 6,T5,5]   ;STORE BITS RIGHT
	MOVEI	T4,0		;INITIALIZE REPEAT COUNT
	LDB	T2,T3		;GET BYTE COUNT BACK
BMSK2F:	ILDB	T1,T3		;GET BYTE OF COUNT
	IDPB	T1,T5		;SAVE IN REPEAT REGISTER
	SOJG	T2,BMSK2F	;MOVE??
	POP	PP,T1		;NO - DONE
	POP	PP,T2
	JRST	BMASK2		;GO BACK TO TOP

BMASK3:	PUSH	LIT,T2		;STASH LAST OP
	POPJ	PP,		;AND EXIT

;ITEM IS NOT EDITED SO IT MUST BE "BLANK WHEN ZERO".

BMASK4:	MOVE	T1,SIZEB
BMASK5:	CAIGE	T1,^D9
	JRST	BMASK6
	PUSH	LIT,[0]
	SUBI	T1,^D9
	JUMPG	T1,BMASK5	;LUP UNTIL DONE

BMASK6:	MOVEI	T2,0
	MOVE	T3,[POINT 4,T2]
	JUMPE	T1,BMASK7	;NO RESIDUE
	IBP	T3
	SOJG	T1,.-1

BMASK7:	MOVEI	T5,17
	IDPB	T5,T3
	JRST	BMASK3
;RANDOM BYTE POINTER DIDLERS

;GET A BYTE POINTER TO "A"

BYTE.A:	MOVEI	T5,BASEA

BYTE.X:	HRRZ	T3,MODEX(T5)
	HLRZ	T2,RESX(T5)
	LSH	T2,6
	ADD	T2,BYTE.S(T3)
	ROT	T2,-^D12

BYTE.Y:	HRR	T2,BASEX(T5)
	ADD	T2,INCRX(T5)	;ADDR OR WORD
	POPJ	PP,

;SIMILAR TO BYTE.A, EXCEPT FOR "B"

BYTE.B:	MOVEI	T5,BASEB
	JRST	BYTE.X

;SIMILAR TO BYTE.B, EXCEPT SIZE PUT IN BITS 6-17

BYTE.C:	MOVEI	T5,BASEB
	HLRZ	T2,RESB
	LSH	T2,^D12
	ADD	T2,SIZEB
	HRLZS	T2
	JRST	BYTE.Y

;CREATE BYTE POINTER TO 'A' AND PUT IN LITROL

MBYTEA:	HLRZ	T2,RESA
	ROT	T2,-6
	HRRZ	T3,MODEA
	MOVE	T3,BYTE.S(T3)
	DPB	T3,[POINT 6,T2,11]
	HRR	T2,BASEA
	ADD	T2,INCRA
	PUSH	LIT,T2
	POPJ	PP,
;INCREMENT PARAMETERS OF "A" OPERAND BY THE NUMBER
;OF BYTES WHOSE VALUE IS IN "T5".

M.IA:	MOVE	T3,MODEA
	MOVE	T4,T5
	IDIV	T4,BYTE.W(T3)	;ADJUST INCREMENT
	ADDM	T4,INCRA
	HLRZ	T4,RESA
	IMUL	T5,BYTE.S(T3)
	SUB	T4,T5
	CAML	T4,BYTE.S(T3)
	JRST	M.IA1
	CAIN	T3,D7MODE
	SUBI	T4,1
M.IA1:	JUMPG	T4,M.IA2	;TO BIT 35 OR BEYOND
	AOS	INCRA		;YES:
	ADDI	T4,^D36
M.IA2:	HRLM	T4,RESA		;NEW RESIDUE
	POPJ	PP,

;SOME RANDOM GENERATORS

;GEN <OP AC+1,"A">

GENOPA:	MOVE	T5,EAC
	AOSA	T5

;GEN <OP AC,"A">

GENOPB:	MOVE	T5,EAC
	DPB	T5,CHAC

;GEN <OP "A">

GENOPC:	HRR	CH,BASEA
	ADD	CH,INCRA
	PUSH	COD,CH
	POPJ	PP,

;GEN <OP AC+1,"B">

GENOPD:	MOVE	T5,EAC
	AOSA	T5

;GEN <OP AC,"B">

GENOPE:	MOVE	T5,EAC
	DPB	T5,CHAC

;GEN <OP "B">

GENOPF:	HRR	CH,BASEB
	ADD	CH,INCRB
	PUSH	COD,CH
	POPJ	PP,

;GEN <MOVE 16,LIT
;     PUSHJ 17,"B">
;
; PUSHJ PP,"B" IS IN CH

GENPUA:	MOVE	T5,EAC
	AOSA	T5

GENPUB:	MOVE	T5,EAC
	LSH	T5,22		;MOVE TO AC FIELD
	SKIPA


GENPUC:	SKIPA	T5,BASEA
	HRR	T5,BASEA
	ADD	T5,INCRA
	PUSH	LIT,T5
	MOVSI	T5,(MOVE 16,)
	HRR	T5,LIT
	PUSH	COD,T5
	PUSH	COD,CH		;PUSHJ PP,ROUTINE
	POPJ	PP,
;ERROR ROUTINES

BADBAD:	TYPE	[ASCIZ "?Illegal subscript usage"]
	JRST	XECUTC
DISERR:	TYPE	[ASCIZ "?DISPLAY internal error"]
	JRST	XECUTC
SMLSUB:	TYPE	[ASCIZ "?Subscript not positive"] ;[24]
	JRST	XECUTC				;[24]
LRGSUB:	TYPE	[ASCIZ "?Subscript too large"]
	JRST	XECUTC
NEDSUB:	TYPE	[ASCIZ "?Item must be subscripted"]
	JRST	XECUTC
NOSUB:	TYPE	[ASCIZ "?No subscripts allowed"]
	JRST	XECUTC
NOTNUF:	TYPE	[ASCIZ "?Not enough subscripts"]
	JRST	XECUTC
TOOFEW:	TYPE	[ASCIZ "?Too many subscripts"]
	JRST	XECUTC
UNDEF:	TYPE	[ASCIZ "?Symbol not defined"]
	JRST	XECUTC
IFE TOPS20,<
HIPART:	TYPE	[ASCIZ '?Not allowed for write-protected hi-segment procedures']
	JRST	XECUTC
>

;ROUTINE TO GET SOME TEMP STORAGE

GETEMP:	ADD	T1,TEMPC	;GET NEW TOP
	CAIL	T1,N.TMP	;OVER?
	JRST	NOTEMP
	EXCH	T1,TEMPC	;RETURN BASE
	POPJ	PP,

NOTEMP:	TYPE	[ASCIZ "?Not enough temp storage"]
	JRST	XECUTC
NOLAST:	TYPE	[ASCIZ "?No previous data-name"]
	JRST	XECUTC
;ROUTINE TO TYPE SYMBOL NAME FROM DNAME6
TYPSNM:
IFE BIS,<
	MOVE	T1,[POINT 6,DNAME6] ;COPY TO ASCII NAME
	MOVE	T2,[POINT 7,DNAME7]
>
IFN BIS,<
	DMOVE	T1,[POINT 6,DNAME6  ;COPY TO ASCII NAME
		    POINT 7,DNAME7]
>
TYPSN0:	ILDB	T3,T1		;GET A CHAR
	JUMPE	T3,TYPSN1	;JUMP IF BLANK
	ADDI	T3,40		;MAKE IT ASCII
	CAIN	T3,":"		;MAKE COLONS INTO
	 MOVEI	T3,"-"		;DASHES
	CAIN	T3,";"		;Make semicolon
	 MOVEI	T3,"."		;Into dot
	IDPB	T3,T2
	JRST	TYPSN0		;LOOP
	POPJ	PP,

TYPSN1:	IDPB	T3,T2		;STORE NULL AT END
	TYPE	DNAME7		;TYPE IT OUT
	POPJ	PP,		;RETURN
SUBTTL	COMMAND PROCESSORS -- SHOW SYMBOLS

;SHOW SYMBOLS <SYMBOL-NAME-MASK> SHOWS ALL SYMBOLS FOR WHICH THE USER
; HAS TYPED A MATCHING MASK

DOSHOS:	SKIPN	@%DT		;ARE SYMBOLS AVAILABLE?
	 JRST	[TYPE	[ASCIZ/?No symbols available
/]
		JRST	XECUTX]
	TXZ	SW,NUIFLG	;SET FLAG IF AT LEAST ONE FOUND
	HRRZ	DT,@%NM		;MAKE DT POINT AT HDR OF NAMTAB ENTRIES
	AOSA	DT

DOSHO1:	ADDI	DT,1(W1)	;GET NEXT ENTRY
	HLRZ	W1,(DT)		;W1= LH(HDR) = # WORDS IN SYMBOL
	JUMPE	W1,DONSHO	;JUMP IF THRU TABLE
	MOVE	T1,1(DT)	;GET FIRST WORD OF SYMBOL NAME
	CAMN	T1,[SIXBIT /:GENER/] ;DON'T CHECK THESE
	 JRST	DOSHO1

;DT POINTS TO A SYMBOL, W1 TELLS US HOW MANY WORDS IT IS.
; SEE IF THE MASK MATCHES.. IF SO, PRINT OUT THE SYMBOL.
; (SPEED IS NOT A CONSIDERATION IN THIS ALGORITHM)

	MOVE	W2,[POINT 6,DNAME6] ;PTR TO MASK
	HRRZI	T5,1(DT)	;PTR TO SYMBOL NAME
	HRLI	T5,(POINT 6,)
	HRRZ	T4,W1		;GET # WORDS IN SYMBOL
	IMULI	T4,6		;MAX # CHARS IN THE SYMBOL
DOSHO2:	ILDB	T1,W2		;T1= CHAR FROM MASK
	ILDB	T2,T5		;T5= CHAR FROM SYMBOL
	PUSHJ	PP,SHRMTC	;CALL RECURSIVE MATCH ROUTINE
	 JRST	DOSHO1		;NO MATCH, TRY NEXT SYMBOL

;HERE IF MASK MATCHES.. TYPE OUT SYMBOL
DOSHOY:	MOVEI	T1," "		;TYPE A SPACE
	TYPEAC	T1
	PUSHJ	PP,TYPNDT	;TYPE THE NAME
	TYPE	CRLF		;AND A CRLF
	TXO	SW,NUIFLG	;AT LEAST ONE MATCHED.. SET FLAG
	JRST	DOSHO1		;LOOP FOR ALL SYMBOLS

;HERE WHEN DONE TABLE
DONSHO:	TXNN	SW,NUIFLG	;SKIP IF WE TYPED ANY
	 JRST	[TYPE	[ASCIZ/% No symbol names match input mask
/]
		JRST	.+1]
	JRST	XECUTX		;RETURN
;RECURSIVE ROUTINE TO MATCH REST OF SYMBOL NAME.
;W2/ PTR TO MASK
;T5/ PTR TO SYMBOL NAME
;T2/ CURRENT CHAR IN SYMBOL NAME
;T1/ CURRENT CHAR IN MASK
;	PUSHJ	PP,SHRMTC
;	RETURN HERE IF NO MATCH
;	RETURN HERE IF MATCH

SHRMTC:	CAIN	T1,"*"-40	;STAR?
	 JRST	DOSHST		;YES
	CAIN	T1,"?"-40	;QUEST?
	 JRST	DOSHQ1		;YES
	CAIE	T1,(T2)		;EXACT MATCH?
	 POPJ	PP,		;NO, RETURN
	JUMPE	T1,CPOPJ1	;IF BOTH NULLS, EXACT MATCH
DOCMT:	SOJGE	T4,[ILDB T1,W2
		ILDB T2,T5
		JRST SHRMTC]	;GO TRY NEXT SET OF CHARS
	ILDB	T1,W2		;IF A MATCH, MASK WILL HAVE RUN OUT
	CAIN	T1,"*"-40
	 JRST	.-2		;MORE STARS ARE OK
	JUMPN	T1,CPOPJ	;ELSE NO MATCH
	JRST	CPOPJ1

;HERE IF "?" SEEN. MATCH ANY CHAR.
DOSHQ1:	JUMPN	T2,DOCMT	;OK IF T2 NOT NULL
	POPJ	PP,		;ELSE NO MATCH

;HERE IF "*" SEEN. MATCH 0 OR MORE CHARACTERS.
;  CALL OURSELF RECURSIVELY TO CHECK ALL POSSIBLE MATCHES.
DOSHST:	ILDB	T1,W2		;GET NEXT CHAR OF MASK
	CAIN	T1,"*"-40	;STAR AGAIN?
	 JRST	.-2		;YES, EAT EXTRAS
	JUMPE	T1,CPOPJ1	;NO MORE MASK, MATCHES
DOSHS0:	PUSH	PP,W2		;SAVE PTR
	PUSH	PP,T5		;SAVE PTR
	PUSH	PP,T4		;SAVE CHAR COUNT
	PUSHJ	PP,SHRMTC	;DOES THE REST MATCH?
	 JRST	DOSHS1		;NO
	POP	PP,T4		;YES
	POP	PP,T5
	POP	PP,W2
	JRST	CPOPJ1		;GOOD RETURN

;STUFF AFTER * DIDN'T MATCH
DOSHS1:	POP	PP,T4
	POP	PP,T5
	POP	PP,W2
	SOJLE	T4,CPOPJ	;NO MATCH IF NO MORE CHARS IN SYMBOL NAME
	ILDB	T2,T5		;SKIP A CHAR IN SYMBOL NAME
	JUMPE	T2,CPOPJ	;NO MORE.. NO MATCH
	LDB	T1,W2		;REGET THIS CHAR IN MASK
	JRST	DOSHS0		;TRY NOW
;ROUTINE TO TYPE SYMBOL NAME FROM "DT"
;DT POINTS TO NAMTAB ENTRY
TYPNDT:	HLRZ	T4,(DT)		;LENGTH OF SYMBOL IN WORDS
	MOVEI	T2,(DT)
TYPND1:	MOVE	T5,[POINT 6,T3] ;PTR TO SIXBIT WORD
	ADDI	T2,1
	MOVE	T3,(T2)		;GET NEXT SIXBIT WORD FROM ENTRY
TYPND2:	TLNN	T5,760000	;PTR DONE?
	 JRST	TYPND3		;YES
	ILDB	T1,T5		;NO, GET A CHAR
	JUMPE	T1,TYPND4	;SPACE-- SYMBOL NAME DONE
	ADDI	T1," "		;MAKE ASCII
	CAIN	T1,":"		;Convert colon to dash,
	 MOVEI	T1,"-"
	CAIN	T1,";"		;Convert semi-colon to "."
	 MOVEI	T1,"."
	TYPEAC	(T1)		;TYPE IT
	JRST	TYPND2		;LOOP
TYPND3:	SOJG	T4,TYPND1	;LOOP IF MORE WORDS TO DO
TYPND4:	POPJ	PP,		;RETURN
SUBTTL	LOOKNM -- SEARCH FOR A COBOL NAME IN THE SYMBOL TABLE.
; RETURNS DT AND SKIPS IF FOUND.
;ABBREVIATIONS ARE ALLOWED IF UNIQUE.
;FILENAMES ARE ALLOWED AS SYMBOL NAMES IF FLAG "FLNMOK" IS SET.

LOOKNM:	SKIPN	@%DT		;ARE SYMBOLS AVAILABLE?
	 JRST	NOSYMS		;NO, GIVE ERROR
	TXZ	SW,NUIFLG	;CLEAR NOT UNIQUE INITIAL SEGMENT FLAG
	MOVEI	W2,5		;MAKE (T3)= # FULL WORDS IN DNAME6
	SKIPN	T1,DNAME6-1(W2)
	SOJA	W2,.-1		;CONTINUE UNTIL W2 HAS LENGTH OF SYMBOL TYPED

	SETO	W1,		;MAKE W1 A MASK FOR TRAILING BLANKS
	LSH	W1,-6		; OF PARTIAL WORD
	TDNE	T1,W1
	JRST	.-2
	HRRZ	DT,@%NM		;MAKE DT POINT AT HDR OF NAMTAB ENTRIES
	AOSA	DT		;LH (DT) IS PTR TO FIRST MATCHING PROPER INI. SEG.
				;(=0, IF NONE YET)
LOOKN1:	ADDI	DT,1(T4)	;GET NEXT ENTRY
	HLRZ	T4,(DT)		;T4=LH(HDR)
	JUMPE	T4,LOOKN5	;JUMP IF THRU TABLE
	CAMLE	W2,T4		;DON'T BOTHER IF USER SYMBOL LARGER
	JRST	LOOKN1
	HRRZI	T2,(DT)		;INIT LOOP TO COMPARE DNAME6 WITH ENTRY
	SETZI	T3,
LOOKN3:	ADDI	T2,1
	MOVE	T1,(T2)		;GET NEXT SIXBIT WORD FROM ENTRY
	CAME	T1,DNAME6(T3)
	JRST	LOOKN4		;SYMBOL DOESN'T MATCH
	CAIGE	T3,-1(T4)
	AOJA	T3,LOOKN3
	CAIE	T4,5
	SKIPN	DNAME6+1(T3)
	JRST	CPOPJ1		;SUCCESS
	JRST	LOOKN1		;C(DNAM6) LONGER THAN CURRENT ENTRY

LOOKN4:	MOVE	T2,DNAME6(T3)	;TRY MASK ONLY IF C(TE(TH)) IS PARTIAL WORD
	JUMPE	T2,LOOKN6
	TRNE	T2,77
	JRST	LOOKN1		;FAILED ON FULL WORD FROM DNAME6
	ANDCM	T1,W1		;MASK OUT TRAILING CHARS.
	CAME	T1,DNAME6(T3)
	JRST	LOOKN1		;NOT INITIAL SEGMENT.
LOOKN6:	TLNE	DT,-1		;YES
	TXOA	SW,NUIFLG	;WE HAVE SEEN AT LEAST 2 INIT SEG.
	HRLS	DT		;SAVE PTR TO MATCHING INITIAL SEGMENT
	JRST	LOOKN1

LOOKN5:	TXNE	SW,FLNMOK	;FILENAMES OK TOO?
	 JRST	LOOKNF		;YES, CHECK THEM TOO
	TXNE	SW,NUIFLG	;THRU TABLE
	 JRST	NOTUNQ		;NOT UNIQUE
	HLRZS	DT
	JRST	CPOPJ1		;RETURN, GOOD SYMBOL FOUND
;LOOK AT FILENAMES TO SEE IF ANY MATCH
; THE WHOLE THING IS MADE TO WORK AS IF FILENAMES WERE JUST MORE
; SYMBOL NAMES

LOOKNF:	MOVEI	T1,^D30		;UP TO 30 CHARS IN DNAME6
	MOVE	T2,[POINT 6,DNAME6] ;POINT TO INPUT NAME.

;WE HAD TRANSLATED "-" TO ":".  FILE NAMES ARE STORED WITH DASHES,
; SO MAKE THEM "-" AGAIN!
LOOKF0:	SOJL	T1,LOOKF1	;JUMP WHEN DONE
	ILDB	T3,T2		;GET CHARACTER
	CAIE	T3,":"-40	;SKIP IF IT NEEDS TRANSLATING BACK..
	 JRST	LOOKF0		;NO, CONTINUE
	MOVEI	T3,"-"-40	;YES, MAKE IT A "-" AGAIN
	DPB	T3,T2
	JRST	LOOKF0		;LOOP

LOOKF1:	PUSH	PP,DT		;SAVE WHAT WE GOT SO FAR
	TXNE	SW,NUIFLG	;ALREADY NOT UNIQUE?
	 JRST	LOKNFU		;YEAH, SEE IF THIS CLEARS IT UP
	PUSHJ	PP,LOKNF1	;LOOK FOR MATCHING FILENAMES
	TXNE	SW,NUIFLG	;NOT UNIQUE?
	 JRST	LOKFE1		;NOT UNIQUE BECAUSE OF FILENAMES

	SKIPE	DT		;ANY FILENAME MATCH?
	 JRST	LOKRTF		;YES, RETURN IT
	POP	PP,DT		;NO, RESTORE OLD DT
	HLRZS	DT		;JUST A PLAIN SYMBOL, OR NOTHING MATCHED
	JRST	CPOPJ1		;RETURN OK

;LOOK FOR MATCHING FILENAMES, ALREADY HAVE TWO POSSIBLE MATCHES
LOKNFU:	PUSHJ	PP,LOKNF1	;LOOK FOR MATCHING FILENAMES
	TXNE	SW,NUIFLG	;STILL NOT UNIQUE?
	 JRST	[POP PP,(PP)	;YES, THROW AWAY OLD DT.
		JRST NOTUNQ]	;GO GIVE ERROR.

;RETURN FILENAME
LOKRTF:	POP	PP,(PP)		;THROW AWAY OLD DT.
	HLRZS	DT		;GET GOOD FILENAME
	TXO	DT,1B1		;SET BIT 1 FOR "FILENAME"
	JRST	CPOPJ1		;RETURN OK

;SUBROUTINE TO LOOK AT FILENAMES AND CONTINUE PLAYING WITH NUIFLG, ETC.
;-1(PP) IS DT SO FAR.

LOKNF1:	SETZ	DT,		;START WITH FRESH "DT".
	MOVE	T1,CUREPA	;GET CURRENT ENTRY POINT ADDRESS
	HRRZ	T1,1(T1)	;RH(ENTRY-POINT) + 1 = %FILES
	MOVE	T1,(T1)		;GET ADDRESS OF FIRST FILE TABLE.
	MOVEI	T2,1		;T2= FILE NUMBER

;W2 HAS NUMBER OF WORDS OF SYMBOL TYPED
;W1 HAS MASK OF LAST WORD TYPED.

;HERE WITH NEXT FILE TABLE ADDRESS IN T1.
;** WARNING: THE FOLLOWING CODE IS DEPENDENT ON LIBOL FILE-TABLE STRUCTURE **

LOKNF2:	PUSH	PP,T1		;SAVE FT ADDRESS
	SETZ	T3,		;INDEX
LOKNF3:	MOVE	T4,(T1)		;GET NEXT WORD OF F.T. NAME
	CAME	T4,DNAME6(T3)	;DOES IT MATCH?
	 JRST	LOKNF4		;NO
	ADDI	T3,1		;YES, COUNT ANOTHER WORD MATCHED
	CAIE	T3,(W2)		;DID WE LOOK AT ALL FULL WORDS?
	AOJA	T1,LOKNF3	;NO, LOOK AT MORE WORDS.
	CAIE	T3,5		;MATCHED 5 WORDS?
	SKIPN	1(T1)		;OR NO MORE FILENAME?
	 JRST	LOKNFG		;YES, EXACT MATCH.
	JRST	LOKNFA		;ABBREV. MATCH.

LOKNF4:	MOVE	T3,DNAME6(T3)	;TRY MASK ONLY IF LAST IS PARTIAL WORD
	JUMPE	T3,LOKNFA	;ABBREV. MATCH
	TRNE	T3,77
	JRST	LOKNFN		;NO MATCH FOR THIS FULL WORD
	ANDCM	T4,W1		;MASK OUT TRAILING CHARS.
	CAME	T4,T3		;DOES IT MATCH AS FAR AS WE TYPED?
	 JRST	LOKNFN		;NO, GO ON TO NEXT F.T.

;AN ABBREVIATED MATCH FOR THIS NAME.
LOKNFA:	POP	PP,T1		;RESTORE F.T. ADDRESS
	MOVE	T3,-1(PP)	;T3= DT FROM THE SYMBOL SEARCH
	TLNE	T3,-1		;ALREADY SEEN A MATCHING SYMBOL?
	 TXO	SW,NUIFLG	;YES, SET "NOT UNIQUE"
	TLNE	DT,-1		;ALREADY SEEN A MATCHING FILENAME?
	 TXOA	SW,NUIFLG	;YES, SET "NOT UNIQUE"
	HRLZ	DT,T2		;SAVE MATCHING FILE NUMBER
	JRST	LOKNXF		;GO LOOK AT MORE FILENAMES

;GOT AN EXACT MATCH
LOKNFG:	POP	PP,(PP)		;STOP SEARCH NOW..FIXUP STACK
	TXZ	SW,NUIFLG	;TURN OFF "NOT UNIQUE" FLAG
	HRLZ	DT,T2		;REMEMBER FILE NUMBER THAT MATCHED.
	POPJ	PP,		;RETURN

;NO MATCH FOR THIS FILE NAME
LOKNFN:	POP	PP,T1		;RESTORE F.T. ADDRESS

;CHECK FOR MORE FILES
LOKNXF:	HRRZ	T1,F.RNFT(T1)	;GET ADDRESS OF NEXT FILE TABLE
	SKIPN	T1		;IS THERE ANY?
	 POPJ	PP,		;NO, DONE, RETURN.
	AOJA	T2,LOKNF2	;GO LOOK AT THE NEXT ONE
;NOT UNIQUE SYMBOL, BECAUSE AT LEAST ONE FILENAME MATCHED.
LOKFE1:	TYPE	[ASCIZ/? "/]
	PUSHJ	PP,TYPSNM	;TYPE SYMBOL NAME
	TYPE	[ASCIZ/" matches initial segments of more than one symbol,
 including at least one of the file names defined in the module.
/]
	ADJSP	PP,-1		;[47] CLEAN UP STACK
	POPJ	PP,		;ERROR RETURN

;NOT UNIQUE SYMBOL ERROR.
NOTUNQ:	TYPE	[ASCIZ/? "/]
	PUSHJ	PP,TYPSNM	;TYPE SYMBOL NAME
	TYPE	[ASCIZ/" matches initial segments of more than one symbol
 (Type "SHOW SYMBOLS /]
	PUSHJ	PP,TYPSNM	;TYPE IT AGAIN
	TYPE	[ASCIZ/*" to get a list of matching symbols)
/]
	POPJ	PP,		;ERROR RETURN

NOSYMS:	TYPE	[ASCIZ/? No symbols
/]
	POPJ	PP,

CPOPJ2:	AOS	(PP)
CPOPJ1:	AOS	(PP)
CPOPJ:	POPJ	PP,
SUBTTL	QUAL--SEARCH FOR (QUALIFIED) NAME.

;PP LOCATES STACK OF POINTERS TO NAMES IN NAMTAB,
;WITH HIGHEST LEVEL QUALIFIER ON TOP OF STACK, AND -1 MARKING BOTTOM.
;CALL:	(FLAGS: PNFLG SET IF PROCEDURE NAME IS ALLOWED
;		DNFLG SET IF DATANAME IS ALLOWED)
;	PUSHJ	PP,QUAL
;  ** WARNING: ALWAYS CALL WITH "PUSHJ PP,QUAL" , NOT PJRST! **
;RETURNS:
;	.+1 IF ERROR, ERROR MESSAGE TYPED
;	.+2 IF A UNIQUE ENTRY WAS FOUND, ABS ADDRESS OF ENTRY IN W2.
;		ALSO FLAG "PRNMFG" IS SET IF ENTRY IS A PROTAB ENTRY.

QUAL:	SETZI	W2,		;CLEAR W2 INDICATING NO SUCCES YET

;GO DOWN THE STACK TO LOWEST LEVEL ENTRY.

	HRRZ	T1,PP
	SUBI	T1,1		;ACCOUNT FOR PUSHJ TO QUAL
	SKIPL	-1(T1)
	SOJA	T1,.-1

;RH(T1) POINTS AT FIRST NAMPTR ON STACK

;ERROR CHECK: Check the first symbol he mentioned.
; If it is a dataname, make sure we are looking for one.
; If it is a procedure name, set "PRNMFG" and make sure we want one.

	MOVE	T2,(T1)		;GET NAMTAB ITEM
	HRRZ	T2,(T2)		;GET LINK TO FIRST DATAB OR PROTAB OF THAT NAME
	TRC	T2,DTTYPE	;IS IT A DATANAME?
	TRNE	T2,TYPMSK
	 JRST	QUALP		;PROCEDURE NAME
	TXNN	SW,DNFLG	;LOOKING FOR DATAB ENTRY?
	 JRST	QUALE1		;NO, GIVE ERROR
	TRO	T2,DTTYPE	;SET DATANAME BITS AGAIN

;FALL THRU TO NEXT PAGE
;SEARCH FOR QUALIFIED DATANAME

;RH (T2) WILL POINT TO THE NEXT DATAB ITEM OF THAT NAME
;LH (T1) WILL HAVE THE ADDRESS OF A MATCHING ENTRY IF FOUND
;T4= ITEM IN TREE WHERE QUALIFIERS HAVE TAKEN US

;HERE TO CHECK NEXT ITEM OF SAME NAME (ITEM IN T2)
QUAL2:	MOVEI	T3,(T1)		;START AT BOTTOM OF STACK
	HRRZ	T4,T2		;GET DATAB LINK
QUAL2A:	CAIGE	T3,-1(PP)	;ALL QUALIFIERS MATCHED?
	 JRST	QUAL3		;NO

;WE'VE FOUND A MATCHING DATA TABLE ENTRY
	TLNE	T1,-1		;DID WE ALREADY FIND ONE?
	 JRST	QUALE3		;YES, "Not uniquely qualified"
	HRL	T1,T2		;COPY LINK

;CHECK OTHER ITEMS OF THE SAME NAME
QUAL2B:	TRZ	T2,DTTYPE	;GET NEXT ITEM OF SAME NAME
	ADD	T2,@%DT
	HRRZ	T2,(T2)
	JUMPN	T2,QUAL2	;GO SEE IF IT MATCHES

;DONE CHECKING ALL ITEMS OF THE SAME NAME
	TLNN	T1,-1		;ANY MATCH FOUND?
	 JRST	QUALE2		;NO, "Improper qualfication"

;FOUND EXACTLY ONE ITEM THAT MATCHED
	HLRZ	T1,T1		;GET MATCHING ITEM
	TRZ	T1,DTTYPE	;CLEAR TYPE BITS
	ADD	T1,@%DT		;GET ABS. ADDRESS OF ENTRY
	HRRZ	W2,T1		;GET MATCHING ITEM (JUST RH)
	JRST	CPOPJ1		;AND RETURN

;MORE QUALIFIERS WERE GIVEN, TRY TO MATCH THEM FOR THIS ITEM
QUAL3:	ADDI	T3,1		;LOOK AT NEXT QUALIFIER GIVEN
	MOVE	T5,(T3)		;T5 IS NAME OF QUALIFIER

;LOOK AT NEXT FATHER
QUAL30:	TXNE	T4,1B1		;ARE WE AT FILENAME ALREADY?
	 JRST	QUAL2B		;YES, NO MATCH FOR THIS ITEM
	TRZ	T4,DTTYPE
	ADD	T4,@%DT		;T4=FATHER(T4)
	LDB	W1,DTFAL	;[43] SAVE FATHER/BROTHER LINK VALUE
	HLRZ	T4,DTSON(T4)
	JUMPE	T4,QUAL2B	;NO MATCH
	TRNE	T4,DTTYPE	;IS FATHER A DATANAME?
	 JRST	QUAL3A		;YES
	TXO	T4,1B1		;NO, A FILENAME, SET BIT
	CAMN	T5,T4		;DOES QUALIFIER MATCH FILENAME?
	 JRST	QUAL2A		;YES, GO ON TO CHECK FOR MORE QUALIFIERS
				; (IT WILL BE ERROR IF MORE WERE TYPED)
	JRST	QUAL2B		;NO, NO MATCH FOR THIS ITEM
;CHECK FATHER (DATANAME) NAME AGAINST THIS QUALIFIER.
; IF NO MATCH, GO BACK TO QUAL30 TO GO UP THE TREE AND CHECK NEXT FATHER, ETC.
QUAL3A:	JUMPE	W1,QUAL30	;[43]IF BROTHER LINK, CANT SERVE AS QUALIFIER
	HRL	T3,T4		;SAVE DATAB LINK OF FATHER
	TRZ	T4,DTTYPE	;FIND NAMTAB LINK
	ADD	T4,@%DT
	LDB	T4,NMLINK
	ADD	T4,@%NM		;ADD NAMTAB OFFSET
	HRRZ	T4,T4		;[41] CLEAR JUNK FROM LEFT HALF BEFORE TEST
	CAMN	T5,T4		;QUALIFIER MATCH?
	 JRST	[HLRZ T4,T3	;YES, GET DATAB LINK AGAIN
		TLZ T3,-1	;CLEAR LH(T3)
		JRST	QUAL2A] ;GO ON IF MORE QUALFIERS
	HLRZ	T4,T3		;GET READY TO CHECK ITS FATHER
	TLZ	T3,-1		;CLEAR LH(T3)
	JRST	QUAL30
;PROCEDURE NAME QUALIFICATION
; THIS HAS THE SAME LOGIC AS QUAL2 THRU QUAL3A, EXCEPT
; THE METHOD OF GETTING FATHER AND NAMTAB LINKS IS DIFFERENT

QUALP:	TRC	T2,DTTYPE	;TOGGLE BITS AGAIN
	TXNN	SW,PNFLG	; PROCEDURE NAME OK?
	 JRST	QUALE4		;NO, GIVE ERROR
	TXO	SW,PRNMFG	;SET "GOT PROCEDURE NAME"

;HERE TO CHECK NEXT ITEM OF SAME NAME
QULP2:	MOVEI	T3,(T1)		;START AT BOTTOM OF STACK
	CAIGE	T3,-1(PP)	;ANY QUALIFIERS?
	 JRST	QULP3		;YES, GO CHECK THEM

;WE'VE FOUND A MATCHING PROTAB ENTRY
QULP2A:	TLNE	T1,-1		;DID WE ALREADY FIND ONE?
	 JRST	QUALE3		;YES, "Not uniquely defined"
	HRL	T1,T2		;COPY LINK

;CHECK OTHER ITEMS OF THE SAME NAME
QULP2B:	TRZ	T2,PRTYPE	;GET NEXT ITEM OF SAME NAME
	ADD	T2,@%PR
	HRRZ	T2,(T2)		;GET NEXT ITEM OF THE SAME NAME
	JUMPN	T2,QULP2	;GO SEE IF IT MATCHES

;DONE CHECKING ALL ITEMS OF THE SAME NAME
	TLNN	T1,-1		;ANY MATCH FOUND?
	 JRST	QUALE2		;NO, "Improper qualfication"

;FOUND EXACTLY ONE ITEM THAT MATCHED
	HLRZ	T1,T1		;GET MATCHING ITEM
	TRZ	T1,PRTYPE	;CLEAR TYPE BITS
	ADD	T1,@%PR		;POINT TO ENTRY
	HRRZ	W2,T1		;GET ITEM, JUST SAVE RIGHT HALF
	JRST	CPOPJ1		;AND RETURN SUCCESSFUL MATCH


;MORE PROCEDURE NAME QUALIFICATION CODE ON NEXT PAGE..
;A QUALIFIER WAS GIVEN, TRY TO MATCH IT FOR THIS ITEM
QULP3:	ADDI	T3,1		;LOOK AT NEXT QUALIFIER GIVEN
	CAIGE	T3,-1(PP)	;BY THE WAY, ONLY ONE ALLOWED
	 JRST	QUALE2		;ELSE "Improper qualification"
	MOVE	T5,(T3)		;T5 IS NAME OF QUALIFIER
	TXNE	T5,1B1		;FILENAMES NOT ALLOWED
	 JRST	QUALE2		;"improper qualification"

;ITEM MUST BE A PARAGRAPH NAME IN A SECTION, AND THE SECTION NAME
; MUST MATCH
	MOVE	T4,T2		;GET PROTAB LINK
	TRZ	T4,PRTYPE	;CLEAR TYPE BITS
	ADD	T4,@%PR		;LOOK AT THE PROTAB ENTRY
	HRRZ	T5,PR.FLG(T4)	;LOOK AT PAR/SECT FLAG
	ANDI	T5,PR%SEC	;T5=0 IF SECTION NAME
	JUMPE	T5,QUALE2	;"Improper qualification"

;SECTION NAME MUST MATCH
	LDB	T4,SECNAM	;GET SECTION NAME FROM ENTRY IN T4
	ADD	T4,@%PR
	LDB	T4,NMLINK
	ADD	T4,@%NM		;ADD NAMTAB OFFSET
	MOVE	T5,(T3)		;GET NAME OF QUALIFIER
	CAMN	T5,T4		;SAME NAME?
	 JRST	QULP2A		;YES, A MATCH
	JRST	QULP2B		;NO MATCH, GO TRY OTHERS OF SAME NAME
;QUAL ERRORS

;SAW A DATANAME, BUT WE WEREN'T LOOKING FOR ONE.
QUALE1:	MOVE	DT,(T1)		;POINT TO NAMTAB ITEM
	TYPE	[ASCIZ/?Not a procedure name: /]
	PUSHJ	PP,TYPNDT	;TYPE SYMBOL NAME
	TYPE	CRLF		;TYPE A CRLF
	POPJ	PP,		;RETURN

;IMPROPER QUALIFICATION
QUALE2:	TYPE	[ASCIZ/?Improper qualification
/]
	POPJ	PP,		;RETURN

;NOT UNIQUELY QUALIFIED
QUALE3:	TYPE	[ASCIZ/?Not uniquely defined, use more qualification
/]
	POPJ	PP,		;RETURN

;SAW A PROCEDURE NAME, BUT WE WEREN'T LOOKING FOR ONE
QUALE4:	MOVE	DT,(T1)		;POINT TO SYMBOL'S NAMTAB ENTRY
	TYPE	[ASCIZ/?Not a dataname: /]
	PUSHJ	PP,TYPNDT	;TYPE SYMBOL NAME
	TYPE	CRLF
	POPJ	PP,		;RETURN
SUBTTL	COMMAND PROCESSORS -- NEXT

NEXT1:	SKIPN	LAST.		;ANY SAVED NAME?
	 JRST	NOLAST		;NO, COMPLAIN
	SKIPN	SAVSUB		;[24]ANY SUBSCRIPTS ON LAST REFERENCE?
	 JRST [	TYPE	[ASCIZ/?Previous name not subscripted
/]
		JRST	XECUTX]
				;CAREFUL!! SUBSCRIPTS HAVE BEEN
				;STORED IN REVERSE ORDER
	SKIPN	@%NM		;[26] DO WE HAVE A NAMTAB?
	 JRST [	TYPE	[ASCIZ/?No symbols for this module
/]
		JRST	XECUTX]
	ADDM	W2,SAVSUB+1	;[24] INCR/DECR LEAST SUBSCRIPT
	SETZB	W2,DT		;[24] SHOW NO NEW NAME TO DISPLAY, USE LAST PARSED NAME
	MOVEI	W1,DISPGN	;DISPLAY..
	JRST	CODGNR		;GO GENERATE CODE AND DO IT
SUBTTL	COMMAND PROCESSORS -- MODULE

;HERE WHEN "MODULE <CRLF>" TYPED
; SHOW WHAT MODULES ARE IN MEMORY
MODH:	TYPE	[ASCIZ	/
 Current module:  /]
	MOVE	T2,CUREPA	;GET ENTRY POINT ADDRESS
	PUSHJ	PP,PRTMNM
	SKIPE	SUBSPR		;[26] ANY OTHERS?
	JRST	MODJ		;[26] YES
	MOVE	T2,CUREPA	;[27]RELOAD T2
	HRRZ	T2,1(T2)	;[26] GET ADDR OF %FILES
	HRRZ	T2,%%NM.(T2)	;[26] GET NAMTAB BASE
	JUMPN	T2,MODX		;[26] DO WE HAVE ONE?
	TYPE	[ASCIZ / (No symbols)/]	;[26] NO
	JRST	MODX		;[26] 

MODJ:	TYPE	[ASCIZ	/
 Modules currently in core:/]
	MOVE	NM,ETYPTS	;[26] GET ENTRY PTS TABLE
MODL:	SKIPN	T2,(NM)		;IS IT THERE?
	AOBJN	NM,MODL		;NO, ARE THERE MORE?
	JUMPGE	NM,MODX		;[26] ALL DONE?
	TYPE	CRLF
	TYPEC	" "		;TYPE A SPACE
	PUSHJ	PP,PRTMNM
	HRRZ	T2,(NM)		;[26] GET ENTRY PT AGAIN
	HRRZ	T2,1(T2)	;[26] GET ADDR OF %FILES
	HRRZ	T2,%%NM.(T2)	;[26] GET ADDR OF NAMTAB
	JUMPN	T2,MODM		;[26] IS IT THERE?
	TYPE	[ASCIZ / (No symbols)/]	;[26]
MODM:	AOBJN	NM,MODL		;ANY MORE?
MODX:	JRST	XECUTC		;NO, RETURN TO COMMAND SCANNER
;HERE FOR "MODULE <NAME>"  THE NAME IS IN SIXBIT IN T5
MOD.1:	MOVE	NM,ETYPTS	;GET POINTER TO TABLE OF MAIN ADDRESSES
MOD.11:	SKIPE	T3,(NM)		;IS THERE ONE THERE? (THEY MAY
				;DISAPPEAR, IF THEY ARE IN
				;LINK-10 OVERLAYS.)
	CAME	T5,-1(T3)	;YES, IS THIS THE ONE?
	AOBJN	NM,MOD.11	;NO, IF THERE ARE MORE, GO LOOK AT THEM
	JUMPGE	NM,NOTLDD	;"PROGRAM NOT LOADED"
	HRRZM	T3,CUREPA	;SAVE AS CURRENT ENTRY POINT
	HRRZ	T4,1(T3)	;GET ADDRESS OF %FILES FOR THE
				; SPECIFIED MODULE
	HRRZ	T2,%%NM.(T4)	;GET ADDR OF SYMBOL TABLE ADDRESSES
	JUMPE	T2,NOSYMM	;"NO SYMBOLS FOR THAT MODULE"
	PUSHJ	PP,GTTABS	;GET TABLE ADDRESSES
	JRST	XECUTX		;BACK TO COMMAND SCANNER

NOTLDD:	TYPE	[ASCIZ/? Program not loaded
/]
	JRST	XECUTX		;BACK TO COMMAND SCANNER

NOSYMM:	TYPE	[ASCIZ/ No symbols for that module
/]
	JRST	XECUTX		;BACK TO COMMAND SCANNER
SUBTTL	COBDDT DEATH (FATAL ERROR, CAN'T CONTINUE)

;$DIE macro translates to JRST CBDABT.

CBDABT:
IFN TOPS20,<
	HALTF%			;Stop program the TOPS-20 way
>
IFE TOPS20,<
	CALLI	1,12		;Stop program the TOPS-10 way.
>
	JRST	CBDABT		;CONTINUE immediately aborts again.
SUBTTL	COBOL-74 DEBUG MODULE

ENTRY	DEBST.
ENTRY	DBPRO.
ENTRY	DBALT.
ENTRY	DBIO.		;DEBUG ON OPEN, CLOSE, START FILE-NAME
ENTRY	DBRD.
ENTRY	DBCD.		;DEBUG ON CD-NAME
ENTRY	DBDA.		;DEBUG ON DATA-NAME

SUBTTL	INITIALIZATION

;CALLED FROM USER PROGRAM BEFORE CALL TO COBDDT
;CALLED BY
;
;	JSP	16,DEBST.

DEBST.:	SETZM	DEBUG.		;ASSUME WE DON'T WANT DEBUG MODULE
IFN TOPS20,<
	MOVEI	T1,.LNSJB	;JOB-WIDE LOGICAL NAMES
	HRROI	T2,[ASCIZ /DEBUG-MODE/]
	MOVE	T3,[POINT 7,TEMP1]
	LNMST%
	  JRST	NODEB		;NO LOGICAL NAME
	MOVE	T3,TEMP1	;GET NAME
>
IFE TOPS20,<
	MOVE	T1,[.TCRRF,,['DEB',,0
			IOWD	1,T3]]
	TMPCOR	T1,
	  JRST	NODEB		;NO TMPCOR FILE
>
	AND	T3,[BYTE (7) 177,177]	;CLEAR JUNK AFTER "ON"
	CAMN	T3,[ASCIZ /ON/]
	SETOM	DEBUG.		;USE DEBUG MODULE
NODEB:	JRST	0(16)

SUBTTL	DEBUGGING ON PROCEDURE-NAME

;CALLED FROM COBDDT, USE CODE IS
;	PUSHJ	17,C.TRCE
;	  FLAGS	 ,, %PR
;	  <OPTIONAL EXTRA WORDS>
;	  %PARAM ,, USE-PROCEDURE
;
;WHERE %PARAM CONTAINS
;	  FLAGS	 ,, LINE#

;ON ENTRY T5 CONTAINS NO. OF DATA WORDS FOLLOWING TRACE CALL

DBPRO.:	SKIPN	DEBUG.		;DO WE NEED IT?
	JRST	CNPOPJ		;NO, RETURN TO USER
	PUSHJ	PP,ZDEB		;ZERO DEBUG-ITEM
	HRRZ	AP,(PP)		;GET USER'S ARG
	HRRZ	T1,(AP)		;OFFSET TO PROTAB
	PUSHJ	PP,PRONAM	;PUT IN PROCEDURE-NAME
	ADDI	AP,-1(T5)	;BYPASS EXTRA WORDS
	HLRZ	T2,(AP)		;GET %PARAM+N
	HRRZ	T2,(T2)		;GET LINE NUMBER
	SKIPN	T2		;ZERO IS NOT LEGAL
	HALT	.+1
	PUSHJ	PP,LINENO	;PUT IN LINE NUMBER
	HLRZ	T1,(AP)		;GET %PARAM+N AGAIN
	HLRZ	T1,(T1)		;GET INDEX TO DEBUG-CONTENTS
	JUMPE	T1,XCTPRO	;NOTHING SPECIAL
	MOVE	T1,DBPTB-1(T1)	;GET MESSAGE
	PUSHJ	PP,CNFILL	;COPY TO DEBUG-CONTENTS

;EXECUTE THE USERS DEBUGGING ROUTINE

XCTPRO:	ADDM	T5,0(PP)	;FIXUP THE RETURN
	HRRZ	T1,(AP)		;GET USE PROCEDURE
	JRST	UPOPJ		;GO TO USER

;FILL IN DEBUG-CONTENTS

CNFILL:	MOVE	T2,DP.CON
FILL:	HLRZ	T3,T1		;GET COUNT
	HRLI	T1,(POINT 6,)	;INPUT BYTE POINTER
	ADD	T2,DBITEM	;OUTPUT BYTE POINTER
FILL1:	ILDB	T4,T1
	IDPB	T4,T2
	SOJG	T3,FILL1
	POPJ	PP,
SUBTTL	DUBUGGING ON ALTER STATEMENT

;CALLED FROM USER CODE BY
;	PUSHJ	17,DBALT.
;	  TO	,,FROM
;	  LINE#	,,USE PROCEDURE

DBALT.:	SKIPN	DEBUG.		;DO WE NEED IT
	JRST	CPOPJ2		;NO
	PUSHJ	PP,ZDEB		;ZERO DEBUG-ITEM
	HRRZ	AP,(PP)		;GET USER'S ARG
	HLRZ	T2,1(AP)	;GET LINE NUMBER
	PUSHJ	PP,LINENO	;PUT IN LINE NUMBER
	HRRZ	T1,(AP)		;OFFSET TO PROTAB
	PUSHJ	PP,PRONAM	;PUT IN PROCEDURE-NAME
	HLRZ	T1,(AP)		;OFFSET TO PROTAB
	MOVE	T2,DP.CON	;COPY "FROM" NAME TO DEBUG-CONTENTS
	PUSHJ	PP,PRNM1	;PUT IN PROCEDURE-NAME
	MOVEI	T5,2		;NO. OF INST TO SKIP
	AOJA	AP,XCTPRO	;GO TO USER'S ROUTINE
SUBTTL	DEBUGGING ON FILE-NAME

;CALLED FROM USER PROGRAM BY
;	PUSHJ	17,DBIO.
;	  LINE#	,,FILE-TABLE

DBIO.:	SKIPN	DEBUG.		;DO WE NEED IT
	JRST	CPOPJ1		;NO
	PUSHJ	PP,ZDEB		;ZERO DEBUG-ITEM
	HRRZ	AP,(PP)		;GET USER'S ARG
	HLRZ	T2,(AP)		;GET LINE NUMBER
	PUSHJ	PP,LINENO	;PUT IN LINE NUMBER
	HRRZ	AP,(AP)		;FILE TABLE ADDRESS
	MOVE	T1,AP
	HRLI	T1,^D30		;COPY 30 CHARACTERS
	MOVE	T2,DP.NAM	;TO DEBUG-NAME
	PUSHJ	PP,FILL		;PUT IN PROCEDURE-NAME
	HLRZ	T1,F.DEB(AP)	;USE PROCEDURE
	JRST	UPOPJ1		;GO TO USER
;DEBUGGING ON READ OF RECORD FROM FILE-NAME

;CALLED FROM USER PROGRAM BY
;	PUSHJ	17,DBRD.
;	  LINE#	,,FILE-TABLE

DBRD.:	SKIPN	DEBUG.		;DO WE NEED IT
	JRST	CPOPJ1		;NO
	PUSHJ	PP,ZDEB		;ZERO DEBUG-ITEM
	HRRZ	AP,(PP)		;GET USER'S ARG
	HLRZ	T2,(AP)		;GET LINE NUMBER
	PUSHJ	PP,LINENO	;PUT IN LINE NUMBER
	HRRZ	AP,(AP)		;FILE TABLE ADDRESS
	MOVE	T1,AP
	HRLI	T1,DPN.SZ	;COPY 30 CHARACTERS
	MOVE	T2,DP.NAM	;TO DEBUG-NAME
	PUSHJ	PP,FILL		;PUT IN PROCEDURE-NAME
	HLLZ	T1,F.WMRS(AP)	;GET RECORD SIZE
	HRR	T1,F.RREC(AP)	;RECORD ADDRESS
	PUSHJ	PP,CNFILL	;COPY TO DEBUG-CONTENTS
	HLRZ	T1,F.DEB(AP)	;USE PROCEDURE
	JRST	UPOPJ1		;GO TO USER
SUBTTL	DUBUGGING ON CD-NAME

;CALLED FROM USER PROGRAM BY
;	PUSHJ	17,DBCD.
;	  LINE#	,,CD-NAME
;	  0	,,USE-PROCEDURE

DBCD.:	SKIPN	DEBUG.		;DO WE NEED IT
	JRST	CPOPJ2		;NO
	PUSHJ	PP,ZDEB		;ZERO DEBUG-ITEM
	HRRZ	AP,(PP)		;GET USER'S ARG
	HLRZ	T2,(AP)		;GET LINE NUMBER
	PUSHJ	PP,LINENO	;PUT IN LINE NUMBER
	HRRZ	T1,(AP)		;CD TABLE ADDRESS
	PUSHJ	PP,DATNAM	;COPY CD-NAME TO DEBUG-NAME
	PUSH	PP,DT		;BETTER SAVE THIS ONE
	SETZ	T1,		;NO BYTE POINTER SET
	PUSHJ	PP,DBDACN	;COPY DATA TO DEBUG-CONTENTS
	POP	PP,DT
UPOPJ2:	HRRZ	T1,1(AP)	;USE PROCEDURE
	AOS	(PP)
UPOPJ1:	AOS	(PP)
UPOPJ:	JUMPN	T1,(T1)		;GO TO USER
	POPJ	PP,		;GIVE UP IF ZERO
SUBTTL	DEBUGGING ON DATA-NAME

;CALLED FROM USER PROGRAM BY
;	PUSHJ	17,DBDA.
;	  LINE#	,,DATA-NAME
;	  %PARAM,,<USE-PROCEDURE>

;WHERE %PARAM IS A BLOCK OF 4 CONTIGUOUS PARAMS CONTAINING
;%PARAM+0	FIRST SUBSCRIPT
;%PARAM+1	SECOND SUBSCRIPT OR ZERO IF NONE
;%PARAM+2	THIRD SUBSCRIPT OR ZERO IF NONE
;%PARAM+3	BYTE POINTER TO DATA OR ADDRESS IF WORD ALIGNED

DBDA.:	SKIPN	DEBUG.		;DO WE NEED IT
	JRST	CPOPJ2		;NO
	JSR	SAVE		;SAVE ALL THE USER ACCS
	PUSHJ	PP,ZDEB		;ZERO DEBUG-ITEM
	HRRZ	AP,(PP)		;GET USER'S ARG
	HLRZ	T2,(AP)		;GET LINE NUMBER
	PUSHJ	PP,LINENO	;PUT IN LINE NUMBER
	HRRZ	T1,(AP)		;GET DATNAM OFFSET
	PUSHJ	PP,DATNAM	;COPY IT TO DEBUG-NAME
	HLRZ	T1,1(AP)	;ANY SUBSCRIPTS?
	JUMPE	T1,DBDA2	;NO, GO FILL IN DEBUG-CONTENTS

	HLRZ	T1,1(AP)	;GET %PARAM
	MOVE	T2,(T1)		;GET CONTENTS
	PUSHJ	PP,PRSUB1	;FILL IN DEBUG-SUB-1
	HLRZ	T1,1(AP)	;GET %PARAM
	SKIPN	T2,1(T1)	;GET CONTENTS
	JRST	DBDA1		;DONE WITH SUBSCRIPTS
	PUSHJ	PP,PRSUB2	;FILL IN DEBUG-SUB-2
	HLRZ	T1,1(AP)	;GET %PARAM
	SKIPE	T2,2(T1)	;GET CONTENTS
	PUSHJ	PP,PRSUB3	;FILL IN DEBUG-SUB-3
DBDA1:	HLRZ	T1,1(AP)	;GET %PARAM
	MOVE	T1,3(T1)	;GET BYTE POINTER TO DATA
	TLZ	T1,(POINT 63,,35)	;CLEAR BYTE SIZE INCASE MULTIPLE BYTES
DBDA2:	PUSHJ	PP,DBDACN	;FILL IN DEBUG-CONTENTS
	HRRZ	T2,1(AP)	;USE PROCEDURE
	SKIPN	T2
	MOVEI	T2,CPOPJ	;INCASE NO USER ROUTINE
	AOS	(PP)
	AOS	(PP)
	SETOM	TEMP2		;NO PUSH 0 NECESSARY
	JRST	RESTOR		;RESTORE ACCS, FLAGS, AND GO TO USER
;FILL IN DEBUG-CONTENTS
;ENTER WITH T1 = INPUT BYTE POINTER OR ZERO 

DBDACN:	HRRZ	DT,(AP)		;GET DATA-NAME
	ADD	DT,@%DT		;RELOCATE IT
	LDB	T0,DTISIZ	;GET INTERNAL SIZE (INCASE EDITED)
	LDB	T2,DTUSAG	;GET USAGE
	MOVE	T4,DBITEM	;GET BASE ADDRESS
	MOVEM	T2,DP.IDX(T4)	;STORE INDEX
	JRST	@.+1(T2)	;DISPATCH ON USAGE
		CPOPJ		;NO SUCH USAGE - ERROR
		DBDAD6		;DISPLAY-6
		DBDAD7		;DISPLAY-7
		DBDAD9		;DISPLAY-9
		DBDAD1		;1-WORD COMP
		DBDAD2		;2-WORD COMP
		DBDAD1		;FLOATING POINT
		DBDAD1		;INDEX
		DBDAC3		;COMP-3

DBDAD1:	JUMPN	T1,.+2		;ALREADY SUPPLIED?
	HRRZ	T1,1(DT)	;GET RUN TIME LOCATION
	ADD	T4,DP.CON	;ADDRESS OF DEBUG-CONTENTS
	MOVE	T2,(T1)		;GET DATA
	MOVEM	T2,(T4)
	POPJ	PP,

DBDAD2:	JUMPN	T1,.+2		;ALREADY SUPPLIED?
	HRRZ	T1,1(DT)	;GET RUN TIME LOCATION
	ADD	T4,DP.CON	;ADDRESS OF DEBUG-CONTENTS
	DMOVE	T2,(T1)		;GET DATA
	DMOVEM	T2,(T4)
	POPJ	PP,

DBDAC3:	ADDI	T0,2		;ROUND UP (SIGN PLUS SLACK)
	LSH	T0,-1		;CONVERT TO EBCDIC

DBDAD9:	MOVE	T3,T0		;SET OUTPUT SIZE = INPUT SIZE
	ADD	T4,DP.CN9	;9-BIT BYTE POINTER TO DEBUG-CONTENTS
	JUMPN	T1,[TLO	T1,(POINT 9,,35)	;RESET BYTE SIZE
		JRST	DBDAEX]		;ALREADY SUPPLIED?
	LDB	T1,DTRESD	;NO, GET RESIDUE
	LSH	T1,^D30		;SHIFT INTO PLACE
	TLO	T1,(POINT 9,,35)	;FORM BYTE POINTER
	HRR	T1,1(DT)	;GET RUN TIME LOCATION
	JRST	DBDAEX

DBDAD7:	MOVE	T3,T0		;SET OUTPUT SIZE = INPUT SIZE
	ADD	T4,DP.CN7	;7-BIT BYTE POINTER TO DEBUG-CONTENTS
	JUMPN	T1,[TLO	T1,(POINT 7,,35)	;RESET BYTE SIZE
		JRST	DBDAEX]		;ALREADY SUPPLIED?
	LDB	T1,DTRESD	;NO, GET RESIDUE
	LSH	T1,^D30		;SHIFT INTO PLACE
	TLO	T1,(POINT 7,,35)	;FORM BYTE POINTER
	HRR	T1,1(DT)	;GET RUN TIME LOCATION
	JRST	DBDAEX

DBDAD6:	MOVE	T3,T0		;SET OUTPUT SIZE = INPUT SIZE
	ADD	T4,DP.CON
	JUMPN	T1,[TLO	T1,(POINT 6,,35)	;RESET BYTE SIZE
		JRST	DBDAEX]		;ALREADY SUPPLIED?
	LDB	T1,DTRESD	;NO, GET RESIDUE
	LSH	T1,^D30		;SHIFT INTO PLACE
	TLO	T1,(POINT 6,,35)	;FORM BYTE POINTER
	HRR	T1,1(DT)	;GET RUN TIME LOCATION
DBDAEX:
IFN BIS,<
	EXTEND	T0,[MOVSLJ
			0]
	  JFCL			;TOO BAD IF IT FAILS
>
IFE BIS,<
	ILDB	T2,T1
	IDPB	T2,T4
	SOJG	T0,DBDAEX
>
	POPJ	PP,
;ZERO THE DEBUG-ITEM & SETUP VARIOUS ITEMS FOR LATER

ZDEB:	MOVE	T2,%DB		;GET TABLE ADDRESS OF DEBUG-ITEM
	ADD	T2,@%DT		;ADD IN DATAB BASE
	HRRZ	T1,1(T2)	;GET RUN-TIME ADDRESS
	MOVEM	T1,DBITEM	;SAVE IT FOR REST OF CALLS
	HRRZ	T2,5(T2)	;GET SIZE
	ADDI	T2,5		;ROUND UP
	IDIVI	T2,6		;GET NO. OF WORDS
	ADDI	T2,-1(T1)	;END OF IT
	HRL	T1,T1
	SETZM	(T1)		;CLEAR FIRST WORD
	ADDI	T1,1		;FORM BLT POINTER
	BLT	T1,(T2)		;CLEAR ALL
	POPJ	PP,

;COPY LINE NUMBER TO DEBUG-LINE
;
;ENTER WITH LINE# IN T2
;USES T1, T2, T3

LINENO:	MOVE	T1,DBITEM	;GET BASE
	HRLI	T1,DP.LIN	;BYTE PTR TO DEBUG-LINE
	CAIGE	T2,^D10
	IBP	T1
	CAIGE	T2,^D100
	IBP	T1
	CAIGE	T2,^D1000
	IBP	T1
	CAIGE	T2,^D10000
	IBP	T1
	CAIGE	T2,^D100000
	IBP	T1
LINEN1:	IDIVI	T2,^D10
	HRLM	T3,(PP)		;OLDE RECURSIVE NUMBER PRINTER
	SKIPE	T2		;DONE
	PUSHJ	PP,LINEN1
	HLRZ	T2,(PP)
	ADDI	T2,'0'
	IDPB	T2,T1
	POPJ	PP,
;COPY DATAB NAME TO DEBUG-NAME
;
;ENTER WITH %DT OFFSET IN T1
;USES T1, T2, T3, T4, AND T5

DATNAM:	MOVE	T2,DP.NAM
	ADD	T2,DBITEM
	MOVEI	T5,DPN.SZ	;SIZE OF DEBUG-NAME
DATNM1:	TRZ	T1,TYPMSK	;CLEAR TYPE BITS
	ADD	T1,@%DT		;GET DATAB LINK TO NAMTAB
	PUSH	PP,T1		;SAVE DATAB LINK
	HLRZ	T1,DTNAM(T1)	;GET NAMTAB LINK
	PUSHJ	PP,DATNM3	;COPY IT TO DEBUG-NAME
	POP	PP,T1		;GET BACK DATAB LINK
	HRRZ	T3,DTNAM(T1)	;GET LINK TO DATAB WITH SAME NAME
	JUMPN	T3,DATNM2	;NOT UNIQUE FOR SURE
	HLRZ	T3,DTNAM(T1)	;GET LINK TO NAMTAB
	ADD	T3,@%NM		;GET ADDRESS
	HRRZ	T3,(T3)		;GET DATAB LINK
	TRZ	T3,TYPMSK	;REMOVE TYPE BITS
	ADD	T3,@%DT		;GET ADDRESS
	CAMN	T1,T3		;IS IT UNIQUE?
	POPJ	PP,		;YES, ALL DONE
DATNM2:	MOVE	T3,DTFLAG(T1)	;GET VARIOUS FLAGS
	TXNN	T3,DTLINK	;IS THIS THE FATHER LINK?
	JRST	[HLRZ	T1,DTSON(T1)	;NO, GET BROTHER LINK
		TRZ	T1,TYPMSK	;REMOVE TYPE BITS
		ADD	T1,@%DT		;RELOCATE IT
		JRST	DATNM2]		;AND TRY THIS ONE
	HLRZ	T1,DTSON(T1)	;YES, GET IT
	JUMPE	T1,CPOPJ	;SHOULD NEVER HAPPEN
	SUBI	T5,4		;ACCOUNT FOR THE ' OF '
	JUMPL	T5,CPOPJ	;NOT ENOUGH ROOM FOR IT, GIVE UP
	IBP	T2		;SPACE
	MOVEI	T4,'O'
	IDPB	T4,T2
	MOVEI	T4,'F'
	IDPB	T4,T2
	IBP	T2
	JRST	DATNM1		;DO QUALIFICATION

DATNM3:	ADD	T1,@%NM		;ADD IN BASE
	HLRZ	T3,(T1)		;GET NO OF WORDS
	IMULI	T3,6		;MAX. NO. OF CHARACTERS
	HRLI	T1,(POINT 6,)
	ADDI	T1,1		;BYTE POINTER TO NAME
DATNM4:	ILDB	T4,T1
	JUMPE	T4,CPOPJ
	CAIN	T4,':'
	 MOVEI	T4,'-'		;CONVERT ":" BACK TO "-"
	CAIN	T4,';'
	 MOVEI	T4,'.'		;Convert ";" back to "."
	SOJL	T5,CPOPJ	;DON'T STORE IF TOO MANY CHARACTERS
	IDPB	T4,T2
	SOJG	T3,DATNM4
	POPJ	PP,

;COPY PROCEDURE NAME TO DEBUG-NAME
;
;ENTER WITH %PR OFFSET IN T1
;USES T1, T2, T3, T4
;MUST NOT USE T5

PRONAM:	MOVE	T2,DP.NAM
PRNM1:	ADD	T2,DBITEM
	ADD	T1,@%PR		;ADD IN BASE
	LDB	T1,[POINT 15,0(T1),17]	;GET NAMTAB ADDRESS
PRNM2:	ADD	T1,@%NM		;ADD IN BASE
	HLRZ	T3,(T1)		;GET NO OF WORDS
	IMULI	T3,6		;MAX. NO. OF CHARACTERS
	HRLI	T1,(POINT 6,)
	ADDI	T1,1		;BYTE POINTER TO NAME
PRNM3:	ILDB	T4,T1
	JUMPE	T4,CPOPJ
	CAIN	T4,':'
	 MOVEI	T4,'-'		;CONVERT ":" BACK TO "-"
	CAIN	T4,';'
	 MOVEI	T4,'.'		;CONVERT ";" BACK TO "."
	IDPB	T4,T2
	SOJG	T3,PRNM3
	POPJ	PP,
;COPY %PARAM TO DEBUG-SUB

;ENTER WITH SUBSCRIPT VALUE IN T2
;USES T1, T2, T3

PRSUB1:	MOVE	T1,DP.SB1	;GET BYTE POINTER
	JRST	.+3
PRSUB2:	SKIPA	T1,DP.SB2
PRSUB3:	MOVE	T1,DP.SB3
	ADD	T1,DBITEM	;ADD IN BASE
	MOVEI	T3,'+'
	IDPB	T3,T1		;DEPOSIT SIGN
	IDIVI	T2,^D10000	;ONLY SPACE FOR +9999
	MOVE	T2,T3		;SO TRUNCATE
	IDIVI	T2,^D1000	;GET THOUSANDS
	ADDI	T2,'0'
	IDPB	T2,T1
	MOVE	T2,T3
	IDIVI	T2,^D100
	ADDI	T2,'0'
	IDPB	T2,T1
	MOVE	T2,T3
	IDIVI	T2,^D10
	ADDI	T2,'0'
	IDPB	T2,T1
	ADDI	T3,'0'
	IDPB	T3,T1
	POPJ	PP,
	SUBTTL	CONSTANTS

;BYTE POINTERS TO DEBUG-ITEM

DP.LIN==(POINT	6,0)		;DEBUG-LINE
DP.NAM:	POINT	6,1,5		;DEBUG-NAME
DP.SB1:	POINT	6,6,11		;DEBUG-SUB-1
DP.SB2:	POINT	6,7,11		;DEBUG-SUB-2
DP.SB3:	POINT	6,8,11		;DEBUG-SUB-3
DP.CON:	POINT	6,^D10		;DEBUG-CONTENTS
DP.CN7:	POINT	7,^D10		;...
DP.CN9:	POINT	9,^D10		;...

DP.IDX==-1			;ADDRESS OF DEBUG-CONTENTS-INDEX

DPN.SZ==^D30			;SIZE OF DEBUG-NAME

;STANDARD DEBUG-CONTENTS DATA

DBPTB:	^D13,,[SIXBIT /START PROGRAM/]
	^D12,,[SIXBIT /FALL THROUGH/]
	^D13,,[SIXBIT /USE PROCEDURE/]
	^D12,,[SIXBIT /PERFORM LOOP/]
	^D10,,[SIXBIT /SORT INPUT/]
	^D11,,[SIXBIT /SORT OUTPUT/]
	^D12,,[SIXBIT /MERGE OUTPUT/]

	END