	.title	calltr	Trace Path to the Caller
	.ident	/000008/
;+
;
; Index		Trace path to the caller
;
; Usage
;
;	calltrace(outfd);
;	FILE		*outfd;
;
; Description
;
;	calltrace() prints the calling path (from main()) to the
;	routine that called calltrace()) on the indicated file.
;	The path is printed on one line as:
;
;		[ main sub1 sub2 ]
;
;	If a subroutine within the path was not compiled with
;	profiling, or does not start with a call to the C register
;	register save routine, it will be printed as <nnnnnn>
;	(where <nnnnnn> is the octal address of the entry to the routine).
;	Note that the last entry on the line is the routine that
;	invoked calltrace().
;
;	A call trace will be printed on exit if profiling is enabled
;	and the program aborts or calls error().
;
; Internal
;
;	Warning -- this routine is sensitive to the format of
;	the environment frame and profile information layout.  If
;	csv$, pcsv$, or $$prof change, this may have to be modified.
;
;	A special entry for error() is provided, which allows the
;	proper "bug" address to be displayed, rather than the return
;	address of error() itself.
;
; Bugs
;
;-
;
; Edit history
; 000001 27-Jun-80 MM		Initial edit
; 000002 30-Jun-80 MM		Add error()
; 000003 ??-???-80
; 000004 ??-???-80
; 000005 15-Jul-80 RB Denny	Fix up $$ctra entry for correct address.
; 000006 15-Jul-80 RB Denny	Catch odd address during chain back
; 000007 18-Jul-80 MM		"bug at ..." message fixed
; 000008 13-Oct-80 MM		Random return in $$ctra fixed edits removed
;
LF	=	12			;Line feed
	.enabl	gbl,lc
	.psect	c$data
name:	.word	0			;For call of $$ctra
	.asciz	/error/			;fake a name for the trace
setup:	.asciz	<LF>/[/			;Line feed on entrance
done:	.asciz	/ ]/<LF>		;Line feed on exit, too
dunno:	.asciz	/ <bug at %06o>/	;Didn't spot a jsr pc, foo
noname:	.asciz	/ <%06o>/		;If we don't know it's name
isname:	.asciz	/ %s/			;If we do know it's name
loop:	.byte	1			;Count times through error()
	.even

	.psect	c$code
calltr::
	jsr	r5,csv$			;Save environment
	mov	C$PMTR+0(r5),r4		;r4 -> output file
	mov	r5,r3			;r3 -> environment
	call	10$			;Do the work
	mov	#done,(sp)		;Print final message
	mov	r4,-(sp)		;on the file
	call	fprintf			;using fprintf
	jmp	cret$
;
; Recurse through the environment list 'till the 0 from $$main
;
10$:
	tst	r3			;Done yet?
	bne	20$			;Continue if more
	return				;Done with this one

20$:
	mov	r3,-(sp)		;Save current environment
	mov	(r3),r3			;Chain back
	call	10$			;Try another
	mov	(sp),r3			;Get current environment, keep stack
;
; Print the environment
;
	mov	(r3),r1			;r1 -> caller's environment
	bne	30$			;Br if there was one
	mov	#setup,-(sp)		;At main, say so
	br	60$			;Continue main sequence

30$:
	mov	2(r1),r1		;r1 -> caller**2 return address
	bit	#1,r1			;Odd address?
	bne	35$			;if so, absolutely a ??
	cmp	-4(r1),#4767		;jsr pc, foo
	beq	40$			;continue if so
	cmp	-4(r1),#4777		;jsr pc, @foo	(from calltr)
	bne	35$			;trouble if not
	mov	-2(r1),r0		;r0 -> called routine store (offset)
	add	r1,r0			;r0 -> called routine store (exact)
	mov	(r0),r0			;r0 -> called routine
	br	45$			;continue

35$:	mov	r1,(sp)			;r1 -> non jsr pc
	mov	#dunno,-(sp)		;nope, it's sick
	br	60$			;go print it

40$:
	mov	-2(r1),r0		;Offset to caller
	add	r1,r0			;r0 -> caller entry address
45$:
	cmp	(r0),#4567		;check for jsr r5,pcsv
	bne	50$			;not call to pcsv
	mov	2(r0),r1		;what's it calling
	add	r0,r1			;relocate it
	cmp	r1,#pcsv$-4		;pointing right?
	bne	50$			;Br if calling csv$
	mov	4(r0),(sp)		;plant profile buffer start
	add	#2,(sp)			;text starts at second word
	mov	#isname,-(sp)		;format string
	br	60$

50$:
	mov	r0,(sp)			;Plant subroutine entry address
	mov	#noname,-(sp)		;format string

;
; Print the (partial) calling string, on entrance:
;	2(sp)	argument (or dummy)
;	0(sp)	format string
;

60$:
	mov	r4,-(sp)		;iov
	call	fprintf			;print it
	add	#6,sp			;pop stack
	return				;back we go
;
; This is called from error() if tracing was enabled.
; $$ctra calls pcsv$ to force "error" into the trace.
;
$$ctra::
	jsr	r5,pcsv$	;Establish context with pcsv
	.word	name		;Who we are
	asrb	loop		;How often hither
	bcc	10$		;Too often, sorry
	mov	stderr,(sp)	;Trace to stderr
	call	calltr		;Do a trace
10$:
	jmp	cret$		; and exit
	.end
