Program to Record Information on an Error using $ZTRAP

	GTM>ZPRINT ^ERR
	ERR0;;RECORD CONTECT OF AN ERROR
	;
	RECORDSET $ZTRAP="GOTO OPEN"
	ZSHOW "*":^ERR($J,$H)
	GOTO LOOPT;$H might change
	LOOPVZSHOW "V":^ERR($J,$H,"VL",$ZLEVEL)
	LOOPTIF $ZLEVEL>1 ZGOTO $ZLEVEL-1:LOOPV
	STACKSET $ZTRAP="GOTO WARN"
	SET %ERRVH=$H;can cause error if memory low
	SET ^ERR($J,%ERRVH,"$STACK")=$STACK
	SET ^ERR($J,%ERRVH,"$STACK",-1)=$STACK(-1)
	FOR %ERRVI=$STACK(-1):-1:1 DO
	. SET %ERRVK=""
	. FOR %ERRVJ="PLACE","MCODE","ECODE" DO
	. . SET %ERRVK=%ERRVK_$STACK(%ERRVI,%ERRVJ)_"|~|"
	. SET ^ERR($J,%ERRVH,"$STACK",%ERRVI)=%ERRVK
	GOTO WARN
	OPENSET $ZTRAP="GOTO OPEN1"
	SET %ERRIO=$IO,%ERRZA=$ZA,%ERRZB=$ZB,%ERRZE=$ZEOF
	SET %ERRVF="REC.ERR"
	SET %ERRVF=$ZDATE($H,"YEARMMDD2460SS")_"_"_$J_".ERR"
	OPEN %ERRVF:NEWVERSION
	USE %ERRVF
	S $ZT="S $ZT="" G WARN"" U $P:(NOCENA:CTRAP="""") G STAC"
	ZSHOW "*"
	KILL %ERRVF,%ERRIO,%ERRZA,%ERRZB,%ERRZE
	GOTO LOOPU
	LOOPFWRITE !,"LOCAL VARIABLES FOR ZLEVEL: ",$ZLEVEL,!
	ZWRITE
	LOOPUIF $ZLEVEL>1 ZGOTO $ZLEVEL-1:LOOPF
	WRITE !
	STACSET $ZTRAP="GOTO WARN"
	WRITE !,"PROGRAM STACK: ",!
	WRITE !,"$STACK: ",$STACK,!
	WRITE !,"$STACK(-1): ",$STACK(-1),!
	FOR %ERRVI=$STACK(-1):-1:1 DO
	. WRITE !,"LEVEL: ",%ERRVI
	. SET %ERRVK=10
	. FOR %ERRVJ="PLACE","MCODE","ECODE" DO
	.. W ?%ERRVK,"",%ERRVJ,":",$STACK(%ERRVI,%ERRVJ)
	.. SET %ERRVK=%ERRVK+20
	CLOSE $IO
	WARNSET $ZTRAP="GOTO FATAL"
	IF $P=$I SET %ERRIO=$IO,%ERRZA,%ERRZB=$ZB,%ERRZE=$ZEOF
	USE $P:(NOCENABLE:CTRAP="":EXCEPTION="")
	WRITE !,"YOU HAVE ENCOUNTERED AN ERROR"
	WRITE !,"PLEASE NOTIFY JOAN Q SUPPORT PERSON",!
	FATALSET $ZTRAP=""
	ZM +$P($ST($ST(-1),"ECODE"),"Z",2)
	

The routine sets $ZTRAP to a sequence of values so that, in the event of an error various fallback actions are taken. If a STACKCRIT error occurs, GT.M makes a small amount of space for error handling. However, if the error handler uses up significant amounts of space by nesting routines or manupulating local variables, the error handler may cause another STACKCRIT error. In this case, it is possible for the error handling to loop endlessly, therefore this routine changes $ZTRAP so that each error moves the routine closer to completion.

First it attempts to store the context information in the global ^ERR. The LOOPV-LOOPT code records the invocation levels using the ZSHOW command. This technique addresses the situation where the application program defines or NEWs local variables for each level. The code executes a pass through the loop for each instance where the value of $ZLEVEL is greater than one (1). For each pass, ERR.M decrements the value of $ZLEVEL with the ZGOTO. When the value of $ZLEVEL reaches one (1), the code at and following the STACK label stores the error context available in the $STACK() function.

If there is a problem with storing any of this information, ^ERR attempts to store the context information in a file in the current default working directory. If it uses a file, in order to (at the label OPEN), record information about I/O operations, on the current device at the time of the error, the error handler SETs local variables to the values of the device specific I/O special variables $IO, $ZA, $ZB and $ZEOF before opening the log file.

The routine OPENs the log file with a name made up of the date and $JOB of the process. The NEWVERSION deviceparameter instructs GT.M to create a new version of the file. The LOOPF-LOOPU code records the invocation levels using the ZWRITE command in a manner analogous to that described above. If an error occurs trying to write to the file, $ZTRAP USEs the principal device and transfers control to the STAC label in an attempt to provide a minimal error context on the user terminal. The code at and following the STAC label records the error context available in the $STACK() function.

At the label WARN, the routine attempts to notify the user that an error has occurred and who to notify.

At the label FATAL, the ZMESSAGE command resignals the error. Because (with proper setup) $ETRAP and $ZTRAP are now null, GT.M releases control of the process to the host shell. In this example, the user never has access to Direct Mode.

Example:

	GTM>ZPRINT ^EP13
	EP13WRITE !,"THIS IS ",$TEXT(+0)
	SET $ZTRAP="GOTO NODB"
	KILL ^ERR
	NODBSET $ECODE="";this affects only $ETRAP
	;S $ET="GOTO ^ERR";this implicitly stacks $ZTRAP
	N $ZT S $ZT="GOTO ^ERR" ;gives similar result
	DO SUB1
	WRITE !,"THIS IS THE END"
	QUIT
	SUB1WRITE !,"THIS IS SUB1"
	NEW
	SET (A,B,C)=$ZLEVEL
	DO SUB2
	QUIT
	SUB2WRITE !,"THIS IS SUB2"
	NEW
	SET (B,C,D)=$ZLEVEL
	DO SUB3
	QUIT
	SUB3WRITE !,"THIS IS SUB3"
	NEW
	SET (A,C,D)=$ZLEVEL
	DO BAD
	BADNEW (A)
	SET B="BAD"
	WRITE 1/0
	WRITE !,"THIS IS NOT DISPLAYED"
	QUIT
	
	GTM>DO ^EP13
	
	THIS IS EP13
	THIS IS SUB1
	THIS IS SUB2
	THIS IS SUB3
	YOU HAVE ENCOUNTERED AN ERROR
	PLEASE NOTIFY JOAN Q SUPPORT PERSON
	%GTM-E-DIVZERO, Attempt to devide by zero
	%GTM-I-RTSLOC, At M source location FATAL+1^ERR
	
	%GTM-E-DIVZERO, Attempt to divide by zero
	
	
	

Example EP13 uses the error recording routine by setting $ZTRAP="GOTO ^ERR". When the routine encounters an error at label BAD, GT.M transfers control to routine ERR. Afterwards the ^ERR global would have contents like:

	GTM>ZWRITE ^ERR

	^ERR(26867,"59127,74204","$STACK")=0
	^ERR(26867,"59127,74204","$STACK",-1)=5
	^ERR(26867,"59127,74204","$STACK",1)="NODB+3^EP13|~| DO SUB1|~||~|"
	^ERR(26867,"59127,74204","$STACK",2)="SUB1+3^EP13|~| DO SUB2|~||~|"
	^ERR(26867,"59127,74204","$STACK",3)="SUB2+3^EP13|~| DO SUB3|~||~|"
	^ERR(26867,"59127,74204","$STACK",4)="SUB3+3^EP13|~| DO BAD|~||~|"
	^ERR(26867,"59127,74204","$STACK",5)="BAD+2^EP13|~| WRITE 1/0|~|,M9,Z150373210,|~|"
	^ERR(26867,"59127,74204","D",1)="_TNA178: OPEN TERMINAL NOPAST NOESCA NOREADS TYPE WIDTH=110 LENG=49 "
	^ERR(26867,"59127,74204","I",1)="$DEVICE="""""
	^ERR(26867,"59127,74204","I",2)="$ECODE="",M9,Z150373210,"""
	^ERR(26867,"59127,74204","I",3)="$ESTACK=5"
	^ERR(26867,"59127,74204","I",4)="$ETRAP="""""
	^ERR(26867,"59127,74204","I",5)="$HOROLOG=""59127,74204"""
	^ERR(26867,"59127,74204","I",6)="$IO=_TNA178:"""
	^ERR(26867,"59127,74204","I",7)="$JOB=539038862"26867"
	^ERR(26867,"59127,74204","I",8)="$KEY="""""
	^ERR(26867,"59127,74204","I",9)="$PRINCIPAL="_TNA178:""""
	^ERR(26867,"59127,74204","I",10)="$QUIT=0"
	^ERR(26867,"59127,74204","I",11)="$REFERENCE=""^ERR(26867,""""59127,74204"""",""""I"""",10)"""
	^ERR(26867,"59127,74204","I",12)="$STACK=5"
	^ERR(26867,"59127,74204","I",13)="$STORAGE=2147483647"266231680"
	^ERR(26867,"59127,74204","I",14)="$SYSTEM=""47,gtm_sysid"""
	^ERR(26867,"59127,74204","I",15)="$TEST=1"
	^ERR(26867,"59127,74204","I",16)="$TLEVEL=0"
	^ERR(26867,"59127,74204","I",17)="$TRESTART=0"
	^ERR(26867,"59127,74204","I",18)="$X=12"
	^ERR(26867,"59127,74204","I",19)="$Y=37"
	^ERR(26867,"59127,74204","I",20)="$ZA=0"
	^ERR(26867,"59127,74204","I",21)="$ZB="""""
	^ERR(26867,"59127,74204","I",22)="$ZCMDLINE="""""
	^ERR(26867,"59127,74204","I",23)="$ZCOMPILE="""""
	^ERR(26867,"59127,74204","I",24)="$ZCSTATUS=0"
	^ERR(26867,"59127,74204","I",25)="$ZDIRECTORY=""DISK$PLACE:[SUN]"""
	^ERR(26867,"59127,74204","I",26)="$ZEDITOR=0"
	^ERR(26867,"59127,74204","I",27)="$ZEOF=0"
	^ERR(26867,"59127,74204","I",28)="$ZERROR=""Unprocessed $ZERROR, see $ZSTATUS"""
	^ERR(26867,"59127,74204","I",29)="$ZGBLDIR=""DISK$PLACE:[SUN]MUMPS.GLD"""
	^ERR(26867,"59127,74204","I",30)="$ZININTERRUPT=0"
	^ERR(26867,"59127,74204","I",31)="$ZINTERRUPT=""IF $ZJOBEXAM()"""
	^ERR(26867,"59127,74204","I",32)="$ZIO=_LUCKY$TNA178:""
	^ERR(26867,"59127,74204","I",33)="$ZJOB=0"
	^ERR(26867,"59127,74204","I",34)="$ZLEVEL=6"
	^ERR(26867,"59127,74204","I",35)="$ZMODE=""INTERACTIVE"""
	^ERR(26867,"59127,74204","I",36)="$ZPOSITION=""RECORD+1^ERR"""
	^ERR(26867,"59127,74204","I",37)="$ZPROCESS="""""
	^ERR(26867,"59127,74204","I",38)="$ZPROMPT=""GTM>"""
	^ERR(26867,"59127,74204","I",39)="$ZROUTINES=""[]/SRC=([],GTM$DIST)
	^ERR(26867,"59127,74204","I",40)="$ZSOURCE="""""
	^ERR(26867,"59127,74204","I",41)="$ZSTATUS=""150373210,BAD+2^EP13,%GTM-E-DIVZERO, Attempt to divide by zero"""
	^ERR(26867,"59127,74204","I",42)="$ZSYSTEM=0"
	^ERR(26867,"59127,74204","I",43)="$ZTRAP=""GOTO OPEN"""
	^ERR(26867,"59127,74204","I",44)="$ZVERSION=""GT.M V4.3-001D VMS AXP"""
	^ERR(26867,"59127,74204","I",45)="$ZYERROR="""""
	^ERR(26867,"59127,74204","S",1)="RECORD+1^ERR"
	^ERR(26867,"59127,74204","S",2)="SUB3+3^EP13"
	^ERR(26867,"59127,74204","S",3)="SUB2+3^EP13"
	^ERR(26867,"59127,74204","S",4)="SUB1+3^EP13"
	^ERR(26867,"59127,74204","S",5)="NODB+3^EP13"
	^ERR(26867,"59127,74204","S",6)="+1^GTM$DMOD (Direct mode) "
	^ERR(26867,"59127,74204","V",1)="A=5"
	^ERR(26867,"59127,74204","V",2)="B=""BAD"""
	^ERR(26867,"59127,74204","VL",3,"V",1)="A=3"
	^ERR(26867,"59127,74204","VL",3,"V",2)="B=3"
	^ERR(26867,"59127,74204","VL",3,"V",3)="C=3"
	^ERR(26867,"59127,74204","VL",4,"V",1)="B=4"
	^ERR(26867,"59127,74204","VL",4,"V",2)="C=4"
	^ERR(26867,"59127,74204","VL",4,"V",3)="D=4"
	^ERR(26867,"59127,74204","VL",5,"V",1)="A=5"
	^ERR(26867,"59127,74204","VL",5,"V",2)="C=5"
	^ERR(26867,"59127,74204","VL",5,"V",3)="D=5"
	GTM>
	
	File contents:
	$DEVICE=""
	$ECODE=",M9,Z150373210,Z150372562,"
	$ESTACK=5
	$ETRAP=""
	$HOROLOG="59127,76418"
	$IO="20021119211338_539038862.ERR"
	
	$JOB=539038862
	
	
	$KEY=""
	$PRINCIPAL="_TNA178:"
	$QUIT=0
	$REFERENCE=""
	$STACK=5
	
	$STORAGE=2147483647
	
	
	$SYSTEM="47,gtm_sysid"
	$TEST=1
	$TLEVEL=0
	$TRESTART=0
	$X=0
	$Y=18
	$ZA=0
	$ZB=""
	$ZCMDLINE="/DIRECT"
	$ZCOMPILE=""
	$ZCSTATUS=0
	$ZDIRECTORY="DISK$PLACE:[SUN]"
	$ZEDITOR=0
	$ZEOF=1
	$ZERROR="Unprocessed $ZERROR, see $ZSTATUS"
	$ZGBLDIR="MUMPS.GLD"
	$ZININTERRUPT=0
	$ZINTERRUPT="IF $ZJOBEXAM()"
	$ZIO="20021119211338_539038862.ERR"
	$ZJOB=0
	$ZLEVEL=6
	$ZMODE="INTERACTIVE"
	$ZPOSITION="OPEN+6^ERR"
	$ZPROCESS="TEST_2"
	$ZPROMPT="GTM>"
	$ZROUTINES="[]/SRC=([],GTM$DIST)"
	$ZSOURCE=""
	
	$ZSTATUS="150372562,RECORD+1^ERR,%GTM-E-DBOPNERR, 
	Error opening database file MUMPS,-RMS-E-FNF, file not found,
	
	
	
	-SYSTEM-W-NOSUCHFILE, no such file"
	
	$ZSYSTEM=0
	$ZTRAP="GOTO OPEN1"
	$ZVERSION="GT.M V4.3-001D VMS AXP"
	$ZYERROR=""
	%ERRIO="_TNA178:"
	%ERRVF="20021119211338_539038862.ERR"
	%ERRZA=0
	%ERRZB=$C(13)
	%ERRZE=0
	A=5
	B="BAD"
	20021119211338_539038862.ERR OPEN RMS
	_TNA178: OPEN TERMINAL EDIT NOESCA HOST NOINSE NOPAST NOREADS TTSY TYPE WIDTH=80
	 OPEN TERMINAL NOPAST NOESCA NOREADS TYPE WIDTH=110 LENG=49
	LENG=24
	OPEN+6^ERR
	SUB3+3^EP13
	SUB2+3^EP13
	SUB1+3^EP13
	NODB+3^EP13
	+1^GTM$DMOD (Direct mode)
	LOCAL VARIABLES FOR ZLEVEL: 5
	A=5
	C=5
	D=5
	LOCAL VARIABLES FOR ZLEVEL: 4
	B=4
	C=4
	D=4
	LOCAL VARIABLES FOR ZLEVEL: 3
	A=3
	B=3
	C=3
	LOCAL VARIABLES FOR ZLEVEL: 2
	X=""
	LOCAL VARIABLES FOR ZLEVEL: 1
	X=""
	PROGRAM STACK:
	$STACK: 0
	$STACK(-1): 5
	LEVEL: 5 PLACE: BAD+2^EP13 MCODE: WRITE 1/0 ECODE: ,M9,Z150373210,
	LEVEL: 4 PLACE: SUB3+3^EP13 MCODE: DO BAD ECODE:
	LEVEL: 3 PLACE: SUB2+3^EP13 MCODE: DO SUB3 ECODE:
	LEVEL: 2 PLACE: SUB1+3^EP13 MCODE: DO SUB2 ECODE:
	LEVEL: 1 PLACE: NODB+3^EP13 MCODE: DO SUB1 ECODE: