Digital-Research-Source-Code/CPM OPERATING SYSTEMS/CPM 3.X/CPM 3.0/SOURCE/utl2trc.asm

	ORG	000H
	TITLE	'SID INSTRUCTION BACKTRACE UTILITY 12/26/77'
;
;	BACKTRACE INSTRUCTIONS IN SID
;
;	COPYRIGHT (C) 1977
;	DIGITAL RESEARCH
;	BOX 579, PACIFIC GROVE, CA.
;	93950
;
;	ENTRY VECTOR
TRAC:	JMP	SETUP
;
SYBASE:
;	SYMBOL TABLE SET-UP FOR SID
	DB	'YALPSID',7,LOW DISE,HIGH DISE	;DISPLAY
	DB	'TCELLOC',7,LOW COLE,HIGH COLE	;COLLECT
	DB	'LAITINI',7,LOW INIE,HIGH INIE	;INITIAL
SYLEN	EQU	$-SYBASE	;LENGTH OF SYMBOL TABLE
;
INIE:	JMP	INITIAL
COLE:	JMP	COLLECT
DISE:	JMP	DISPLAY
;
	DB	'COPYRIGHT (C) 1977, DIGITAL RESEARCH   '
;
BDOSE	EQU	0005H	;PRIMARY BDOS ENTRY POINT
DDTBASE	EQU	7*8+1	;ADDRESS OF DDT ENTRY VECTOR
CR	EQU	0DH
LF	EQU	0AH
;
PRLABEL:
	;PRINT SYMBOLIC LABEL GIVEN BY HL
	LXI	B,27
	JMP	GODDT
;
PCHAR:	;PRINT CHARACTER FROM REGISTER A
	LXI	B,9
	JMP	GODDT
;
PADDR:	;PRINT ADDRESS FROM D,E
	PUSH	D	;SAVE A COPY
	MOV	A,D	;HIGH ADDRESS
	CALL	PBYTE	;PRINT BYTE VALUE
	POP	D	;RECALL ADDRESS
	MOV	A,E	;LOW VALUE
;	(DROP THROUGH TO PRINT BYTE)
PBYTE:	;PRINT BYTE VALUE FROM A
	LXI	B,12
GODDT:	LHLD	DDTBASE	;GET ENTRY TO DDT FROM RST 7 LOCATION
	DAD	B
	PCHL
;
PRINT:	;PRINT MESSAGE IN D,E 'TIL FIRST ZERO
	LDAX	D
	ORA	A
	RZ
;	MORE TO PRINT
	INX	D
	PUSH	D
	CALL	PCHAR
	POP	D
	JMP	PRINT
;
CRLF:	;PRINT CARRIAGE RETURN LINE FEED
	PUSH	B
	PUSH	D
	MVI	A,CR
	CALL	PCHAR
	MVI	A,LF
	CALL	PCHAR
	POP	D
	POP	B
	RET
;
SETUP:
	;ARRIVE HERE FROM RELOCATOR TO SETUP BRANCHES
	LHLD	BDOSE+1	;PREVIOUS BDOS ENTRY ADDRESS
	SHLD	TRAC+1	;CHANGE FIRST JMP ADDRESS
	LXI	H,TRAC	;ADDRESS OF FIRST JMP
	SHLD	BDOSE+1	;CHANGE BDOS ENTRY ADDRESS
;
INITIAL:
;	PRINT ENTRY POINT ADDRESSES
	LXI	D,INIMSG
	CALL	PRINT
	LXI	D,INIE
	CALL	PADDR
	LXI	D,COLMSG
	CALL	PRINT
	LXI	D,COLE
	CALL	PADDR
	LXI	D,DISMSG
	CALL	PRINT
	LXI	D,DISE
	CALL	PADDR
;
;	DETERMINE IF THE DISASSEMBLER IS PRESENT
	LDA	DDTBASE+1	;HIGH ORDER ADDRESS OF DDT TO REG-A
	CPI	ENDMOD SHR 8
	JNZ	INIT1
;	DISASSEMBLER HAS BEEN OVERLAYED
	LXI	D,OVERMSG
	MVI	A,1		;MARK AS ADDRESSES ONLY
	JMP	INIT2
INIT1:	;MARK AS FULL TRACE
	XRA	A
	LXI	D,UNDMSG
;
INIT2:	STA	DISFLG	;SET TO 1 IF ADDRESSES ONLY
	CALL	PRINT
	LXI	H,COUNT
	MVI	M,0		;ZERO THE INSTRUCTION COUNT
	LXI	H,ABUFF		;ADDRESS BUFFER
	SHLD	NEXT		;NEXT TO FILL AT BEGINNING OF BUFFER
	LXI	D,SYLEN		;LENGTH OF SYMBOL TABLE
	RET			;BACK TO DDT
;
COLLECT:
;	ENTER WITH INSTRUCTION ADDRESS IN D,E
	LXI	H,COUNT
	MOV	A,M		;INSTRUCTION COUNT
	ORA	A
	JM	FULLC		;STOP AT 128 COUNTS
	INR	M		;NOT AT 128 YET
FULLC:	LHLD	NEXT		;NEXT POSITION TO FILL
	MOV	M,E
	INR	L		;WRAP-AROUND ON PAGE
	MOV	M,D
	INR	L
	SHLD	NEXT
	XRA	A
	RET			;RETURN TO DDT WITH ZERO FLAG
;
DISPLAY:
;	ENTER WITH C=1 IF ONLY ADDRESS TRACE IS REQUESTED
	LXI	H,DISFLG
	MOV	A,M
	ORA	C	;DISFLG = 1 IF DISASSEMBLER NOT PRESENT
	MOV	C,A
	PUSH	B
	LXI	D,TRMSG	;TRACE MESSAGE
	CALL	PRINT
	POP	B
	LXI	H,COUNT
	MOV	B,M		;QUEUE SIZE IN B
	XRA	A		;CLEAR COLUMN COUNT
	STA	COLUMN
	MOV	A,C
	ORA	A	;ADDRESS MODE?
	JNZ	DISP0
;	SAVE OLD PC FROM DISASSEMBLER
	LHLD	PC
	SHLD	TPC
DISP0:	LHLD	NEXT
;
DISP1:	;DISPLAY COLLECTED ADDRESSES OR INSTRUCTIONS
	MOV	A,B	;QUEUE SIZE
	ORA	A
	JZ	ENDISP
	DCR	B	;COUNT SIZE DOWN
	PUSH	B	;SAVE COUNT AND MODE
	DCR	L	;ADDRESS LAST HIGH ORDER ADDRESS
	MOV	D,M
	DCR	L	;ADDRESS LAST LOW ORDER ADDRESS
	MOV	E,M
	PUSH	H		;SAVE NEXT TO GET
	XCHG
;	CHECK MODE OF DISPLAY
	MOV	A,C
	ORA	A
	JZ	FDISP		;FULL DISPLAY?
;
;	PARTIAL ADDRESS DISPLAY
	XCHG		;READY FOR ADDRESS PRINTING
	LXI	H,COLUMN
	MOV	A,M
	INR	M
	ANI	111B	;COUNTS 0-7
	CZ	CRLF		;START NEW LINE
	CALL	PADDR
	MVI	A,' '
	CALL	PCHAR
	JMP	EDISP
;
FDISP:	SHLD	PC		;READY FOR DECODE
	CALL	PRLABEL		;OPTIONAL LABEL
	MVI	A,2
	STA	PAGM		;TO DISPLAY ONE LINE
	CALL	DISENT		;DISPLAYED
EDISP:	POP	H		;RECOVER NEXT TO DECODE
	POP	B		;RECOVER COUNT
	JMP	DISP1
;
ENDISP:	;END OF DISPLAY
	MOV	A,C
	ORA	A
	RZ		;RETURN WITHOUT RESTORING PC
	LHLD	TPC
	SHLD	PC	;DISASSEMBLER'S PC RESTORED
	RET
;
;	MESSAGES
INIMSG:	DB	CR,LF,'INITIAL = ',0
COLMSG:	DB	CR,LF,'COLLECT = ',0
DISMSG:	DB	CR,LF,'DISPLAY = ',0
OVERMSG:
	DB	CR,LF,'"-A" IN EFFECT, ADDRESS BACKTRACE',0
UNDMSG:	DB	CR,LF,'READY FOR SYMBOLIC BACKTRACE',0
TRMSG:	DB	CR,LF,'BACKTRACE:',0
;
;	DATA AREAS
COUNT:	DB	0
NEXT:	DW	ABUFF
TPC:	DS	2
DISFLG:	DS	1	;1 IF ADDRESSES ONLY
COLUMN:	DS	1	;COLUMN COUNT IF ADDRESSES ONLY
NPAGE	EQU	($ + 100H) AND 0FF00H	;NEXT PAGE ADDRESS
	DS	NPAGE-$	;SPACE FROM CURRENT LOCATION
;	ADDRESS BUFFER IS ON A PAGE BOUNDARY
ABUFF:	DS	255
	DB	0
ENDMOD	EQU	$
;
DISEM	EQU	ENDMOD		;DISASSEMBLER ENTRY POINTS
PC	EQU	DISEM+0CH
PAGM	EQU	DISEM+10H
DISENT	EQU	DISEM+06H
	END