.title	TRACEBACK - force a traceback
	.sbttl	documentation
	.ident	/V1.01/
;
;	This is a short procedure to allow causing a traceback (stack dump)
;	at any given time in a program -- useful for debugging recursive
;	programs.  The only limitation on this procedure is that if you use
;	your own condition handlers, they must resignal conditions they
;	can't handle.
;
;	Calling format:
;
;	CALL TRACEBACK
;	  -- or --
;	CALL TRACEBACK('ascii descriptor of text to display with traceback')
;
;	Eric F. Richards
;	14-Aug-1985
;	Gould OSD VAX/VMS V4.1
;
	.sbttl	code
	.disable traceback, debug		  ; don't trace this!
	.enable suppression			  ; keep the list files small
	$shrdef					  ; define shared messages
	tbk$_facility = 9			  ; where this is defined?
	trace_w_text = tbk$_facility@16!shr$_text ; error message code
	.psect	_code, long, exe, nowrt, shr, pic ; code begins

	.entry	traceback, 0			  ; entry point, no reg's saved
	tstb	(ap)				  ; any arguments supplied?
	bnequ	10$				  ; if not, push default msg

	pushal	b^msg				  ; push text-header for trace
	pushl	s^#msglen			  ; push len of msg, build desc
	pushl	sp				  ; push address of desc
	brb	20$				  ; skip to main code

10$:	pushl	4(ap)				  ; push descr for text output

20$:	pushl	#1				  ; push number of arguments
	pushl	#trace_w_text			  ; message: %TRACE-W-TEXT, !AS
	calls	#3, g^lib$signal		  ; signal error
	ret					  ; go back

msg:	.ascii	/Traceback-handler stack display requested/

endmsg:						  ; message buffer
	msglen = endmsg-msg			  ; length of message
	.end					  ; that's it!