Debug.Trace.cls

Class Debug.Trace Extends %RegisteredObject
{

ClassMethod On(aGN As %String = "") As %Status [ ProcedureBlock = 0 ]
{
#define InvalidIO		$io'=$p
	if aGN="" set %TraceLog=$name(^CacheTemp.TraceLog)
	else  set %TraceLog=aGN
	kill @%TraceLog
	for i=1:1:$stack-1 {
		set @%TraceLog@(1)=$listbuild(i,$zhorolog)
		set %TraceLog=$name(@%TraceLog@(1))
	}
	set @%TraceLog@(1)=$listbuild($stack,$zhorolog)
	set tracefile=46
	set wasIO=$io
	
	open tracefile
	use tracefile::("^"_$ZNAME)
	Do $ZUTIL(82,12,1)
	use wasIO
	
	zbreak /trace:all:tracefile
	Quit $$$OK

wstr(line)	;
	new (line,%TraceLog)
	set ts=$zhorolog
	set line=$piece(line,"Trace: ZBREAK at ",2)
	set prevStack=+$listget($get(@%TraceLog@($order(@%TraceLog@(""),-1))))
	set curStack=$stack
	set posInLine=$piece(line," ",2)
	set line=$piece(line," ")
	set routine=$piece(line,"^",2)
	
	quit:routine=$zname ; except current tool
	
	if $qlength(%TraceLog)>20 break
	
	set prevInfoGN=""
	if curStack>prevStack {
		set %TraceLog=$name(@%TraceLog@($order(@%TraceLog@(""),-1)))
	} elseif prevStack>curStack {
		for i=$qlength(%TraceLog):-1:($qlength(%TraceLog)-(prevStack-curStack)) {
			set %TraceLog=$name(@%TraceLog,i)
			do checkPrevLine
		}
	} else {
		do checkPrevLine
	}
	
	Set traceInfo=$listbuild(curStack,ts,0,line,posInLine,$extract($text(@line),posInLine,*))
	set @%TraceLog@($order(@%TraceLog@(""),-1)+1)=traceInfo
	Quit
checkPrevLine
	if $data(@%TraceLog)>10 {
		set prevInfoGN=$name(@%TraceLog@($order(@%TraceLog@(""),-1)))
		set $list(@prevInfoGN,3)=ts-$listget(@prevInfoGN,2)
		set prevPosInLine=$listget(@prevInfoGN,5)
		if $get(line)=$listget(@prevInfoGN,4),$get(posInLine)>prevPosInLine {
			set $list(@prevInfoGN,6)=$extract($text(@line),prevPosInLine,posInLine)
		}
	}
	quit
wchr(s)	;
	Quit
wff()
	Quit
wnl()
	Quit
wtab(s)
	Quit
}

ClassMethod Off() [ ProcedureBlock = 0 ]
{
	new (%TraceLog)
	set ts=$zhorolog
	do checkPrevLine
	set tracefile=46

	Do $ZUTIL(82,12,0)
	
	zbreak /debug
	zbreak /trace:off
	close tracefile

	kill %TraceLog	
	quit $$$OK
}

}