home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 15 / 15.iso / s / s038 / 1.ddi / SUPP.LIF / EXCEPT.PLM < prev    next >
Encoding:
Text File  |  1992-07-06  |  3.8 KB  |  121 lines

  1. $include(subsys.inc)
  2. /***************************************************************************
  3. *
  4. *    module name:    except  (note: module name should always be the same as
  5. *                                    the source file name withou the (extension)
  6. *
  7. *    description:    this module consists of a set of procedures which
  8. *                    deal with in-line exception handling 
  9. *
  10. ***************************************************************************/
  11.  
  12. except:    DO;
  13.  
  14. $include(:rmx:inc/rmxplm.ext)
  15. $include(:rmx:inc/common.lit)
  16. $include(:rmx:inc/error.lit)
  17. $include(:rmx:inc/nstexh.lit)
  18. $include(strng.ext)
  19. $include(convrt.ext)
  20.  
  21. $subtitle('set$exception')
  22. /****************************************************************************
  23. *
  24. *   PROC NAME:        set$exception
  25. *
  26. *    DESCRIPTION:    a procedure to get the exception handler and set the 
  27. *                    exception mode (except$info.mode) to the desired value
  28. *
  29. *    CALL:            CALL set$exception(except$mode);
  30. *
  31. *    INPUTS:            except$mode        a byte containing a value indicating the
  32. *                                    calling task's intended exception mode
  33. *
  34. *    SYSTEM CALLS:    get$exception$handler,set$exception$handler
  35. *
  36. ****************************************************************************/
  37.  
  38. set$exception:    PROCEDURE(except$mode) REENTRANT PUBLIC;
  39.  
  40.     DECLARE except$mode        BYTE,
  41.             except$info        EXCEPTION$INFO$STRUCTURE,
  42.             status            WORD;
  43.  
  44.     CALL RQ$GET$EXCEPTION$HANDLER (@except$info, @status);
  45.     except$info.mode = except$mode;
  46.     CALL RQ$SET$EXCEPTION$HANDLER (@except$info, @status);
  47.  
  48. END set$exception;
  49. $subtitle('error$check')
  50. /****************************************************************************
  51. *
  52. *   PROC NAME:        error$check
  53. *
  54. *    DESCRIPTION:    a procedure to identify errors that occur during system
  55. *                    calls. a message is sent to the console advising you of
  56. *                    the type of error that has occurred and which line in
  57. *                    your code produced it (using number to locate the calling 
  58. *                    line). if no error is detected, control is returned to the
  59. *                    calling module.
  60. *
  61. *    CALL:            CALL error$check(number,test$status);
  62. *
  63. *    INPUTS:            number            a word containing a unique number used to 
  64. *                                    trace the call that produced the error
  65. *                    test$status        a word containing the status returned from
  66. *                                    the last system call
  67. *
  68. *    system calls:    c$format$exception,c$send$eo$response,exit$io$job
  69. *
  70. ****************************************************************************/
  71.  
  72.  
  73. error$check:    PROCEDURE(number,test$status) REENTRANT PUBLIC;
  74.  
  75.     DECLARE 
  76.  
  77.             number            WORD,
  78.             test$status        WORD,
  79.             status            WORD,
  80.             local$string    STRING;                
  81.  
  82.     DECLARE 
  83.  
  84.             cr$lf(*)        BYTE DATA (CR,LF), 
  85.             int$err$msg(*)    BYTE DATA ('INTERNAL ERROR AT #'),
  86.             status$msg(*)    BYTE DATA (' STATUS = '); 
  87.  
  88.     IF test$status = E$OK THEN
  89.         RETURN;
  90.  
  91. /* these two routines(concatenate$to$string,convert$decimal) facilitate 
  92.    the printing of formatted messages. note: string length should be
  93.    initialized to zero before you start concatenating any data.             */
  94.  
  95.     local$string.length = 0;
  96.     CALL concatenate$to$string(@local$string,size(local$string.char),@cr$lf,
  97.                                size(cr$lf),@status);
  98.     CALL concatenate$to$string(@local$string,size(local$string.char),
  99.                                @int$err$msg,size(int$err$msg),@status);
  100.     CALL convert$decimal(@local$string,size(local$string.char),number,
  101.                          5,@status);
  102.     CALL concatenate$to$string(@local$string,size(local$string.char),
  103.                                @status$msg,size(status$msg),@status);
  104.     CALL rq$c$format$exception (@local$string, size(local$string.char),
  105.                                 test$status,
  106.                                 1,
  107.                                 @status);
  108.     CALL concatenate$to$string(@local$string,size(local$string.char),
  109.                                @cr$lf,size(cr$lf),@status);
  110.  
  111. /* send error message to console and exit job using error status code */
  112.  
  113.     CALL rq$c$send$eo$response (nil,0,@local$string,@status);
  114.     CALL rq$exit$io$job (test$status, NIL, @status);
  115. END error$check;
  116.  
  117. END except;
  118.  
  119.  
  120.  
  121.