$compact optimize(3) debug pw(79) rom

utils_mod: DO;

$INCLUDE (utils.lit)
$INCLUDE (:RMX:inc/hi.ext)

/***********************************************************************
 **                                                                   **
 ** OBJECTIVE: To be used as an exception handler by this program.    **
 **                                                                   **
 ** INPUT : [sys$call$ptr] A pointer to a string containing the       **
 **                        system call.                               **
 **         [status] the exception code returned by the system call.  **
 **                                                                   **
 ** OUTPUT: The system call causing the exception, followed by the    **
 **         exception code converted from Hex to Decimal.             **
 **                                                                   **
 ***********************************************************************/
check$exception:	PROCEDURE	(sys$call$ptr,status)	PUBLIC;
	DECLARE	sys$call$ptr	POINTER,
			status			WORD,
			ascii$value	(8)	BYTE,
			hex$char	(*)	BYTE DATA ('0123456789ABCDEF'),
			sys$call$msg(*)	BYTE DATA (22,': SYSTEM CALL FAILED',CR,LF),
			excep$msg	(*)	BYTE DATA (24,'          : EXCEPTION = ');		

	IF (status <> E$OK) THEN
	DO;
		ascii$value(0) = 6;
		ascii$value(1) = hex$char(status/1000h MOD 10h);
		ascii$value(2) = hex$char(status/100h MOD 10h);
		ascii$value(3) = hex$char(status/10h MOD 10h);
		ascii$value(4) = hex$char(status MOD 10h);
		ascii$value(5) = CR;
		ascii$value(6) = LF;

		CALL rq$c$send$co$response (NIL,0,sys$call$ptr,@status);
		CALL rq$c$send$co$response (NIL,0,@sys$call$msg,@status);
		CALL rq$c$send$co$response (NIL,0,@excep$msg,@status);
		CALL rq$c$send$co$response (NIL,0,@ascii$value,@status);
	END;	/*	status <> E$OK	*/

	RETURN;
END check$exception;

   

/***********************************************************************
 **                                                                   **
 ** OBJECTIVE: This function will decrypt any character into its      **
 **            original form. The identity of the original had been   **
 **            preserved by the encryption function.                  **
 **                                                                   **
 ***********************************************************************/
decrypt:	PROCEDURE	(char)	BYTE	PUBLIC;
	DECLARE	char	BYTE;

	RETURN ((ror((char-4),4)));
END decrypt;

/***********************************************************************
 **                                                                   **
 ** OBJECTIVE: This function will encrypt a character into a dif-     **
 **            ferent character, preserving the identity of the       **
 **            original character.                                    **
 **                                                                   **
 ***********************************************************************/
encrypt:	PROCEDURE	(char)	BYTE	PUBLIC;
	DECLARE	char	BYTE;

	RETURN ((rol(char,4))+4);
END encrypt;

END utils_mod;