$include(subsys.inc)
/***************************************************************************
*
*	module name:	except  (note: module name should always be the same as
* 								   the source file name withou the (extension)
*
*	description:	this module consists of a set of procedures which
*					deal with in-line exception handling 
*
***************************************************************************/

except:	DO;

$include(:rmx:inc/rmxplm.ext)
$include(:rmx:inc/common.lit)
$include(:rmx:inc/error.lit)
$include(:rmx:inc/nstexh.lit)
$include(strng.ext)
$include(convrt.ext)

$subtitle('set$exception')
/****************************************************************************
*
*   PROC NAME:		set$exception
*
*	DESCRIPTION:	a procedure to get the exception handler and set the 
*					exception mode (except$info.mode) to the desired value
*
*	CALL:			CALL set$exception(except$mode);
*
*	INPUTS:			except$mode		a byte containing a value indicating the
*									calling task's intended exception mode
*
*	SYSTEM CALLS:	get$exception$handler,set$exception$handler
*
****************************************************************************/

set$exception:	PROCEDURE(except$mode) REENTRANT PUBLIC;

	DECLARE except$mode		BYTE,
			except$info		EXCEPTION$INFO$STRUCTURE,
			status			WORD;

	CALL RQ$GET$EXCEPTION$HANDLER (@except$info, @status);
	except$info.mode = except$mode;
	CALL RQ$SET$EXCEPTION$HANDLER (@except$info, @status);

END set$exception;
$subtitle('error$check')
/****************************************************************************
*
*   PROC NAME:		error$check
*
*	DESCRIPTION:	a procedure to identify errors that occur during system
*					calls. a message is sent to the console advising you of
*					the type of error that has occurred and which line in
*					your code produced it (using number to locate the calling 
*					line). if no error is detected, control is returned to the
*					calling module.
*
*	CALL:			CALL error$check(number,test$status);
*
*	INPUTS:			number			a word containing a unique number used to 
*									trace the call that produced the error
*					test$status		a word containing the status returned from
*									the last system call
*
*	system calls:	c$format$exception,c$send$eo$response,exit$io$job
*
****************************************************************************/


error$check:	PROCEDURE(number,test$status) REENTRANT PUBLIC;

	DECLARE 

			number			WORD,
			test$status		WORD,
			status			WORD,
			local$string	STRING;				

	DECLARE 

			cr$lf(*)		BYTE DATA (CR,LF), 
			int$err$msg(*)	BYTE DATA ('INTERNAL ERROR AT #'),
			status$msg(*)	BYTE DATA (' STATUS = '); 

	IF test$status = E$OK THEN
		RETURN;

/* these two routines(concatenate$to$string,convert$decimal) facilitate 
   the printing of formatted messages. note: string length should be
   initialized to zero before you start concatenating any data.			 */

	local$string.length = 0;
	CALL concatenate$to$string(@local$string,size(local$string.char),@cr$lf,
							   size(cr$lf),@status);
	CALL concatenate$to$string(@local$string,size(local$string.char),
							   @int$err$msg,size(int$err$msg),@status);
	CALL convert$decimal(@local$string,size(local$string.char),number,
						 5,@status);
	CALL concatenate$to$string(@local$string,size(local$string.char),
							   @status$msg,size(status$msg),@status);
	CALL rq$c$format$exception (@local$string, size(local$string.char),
								test$status,
								1,
								@status);
	CALL concatenate$to$string(@local$string,size(local$string.char),
							   @cr$lf,size(cr$lf),@status);

/* send error message to console and exit job using error status code */

	CALL rq$c$send$eo$response (nil,0,@local$string,@status);
	CALL rq$exit$io$job (test$status, NIL, @status);
END error$check;

END except;