home *** CD-ROM | disk | FTP | other *** search
- $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;
-
-
-
-