home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / iclvme2900.tar.gz / iclvme2900.tar / kmt_eh_module < prev    next >
Text File  |  1987-07-14  |  14KB  |  393 lines

  1. MODULE KMT_EH_MODULE;
  2.  
  3. @******************************************************************************@
  4. @*                                                                            *@
  5. @* Mode definitions                                                           *@
  6. @*                                                                            *@
  7. @******************************************************************************@
  8.  
  9. MODE
  10. KMT_MTM_VALUES IS ANY (
  11.    LONG WORD          LW_VALUE,
  12.    LONG INT           LI_VALUE,
  13.    REF WORD           RW_VALUE,
  14.    REF INT            RI_VALUE,
  15.    REF LONG WORD      RLW_VALUE,
  16.    REF LONG INT       RLI_VALUE,
  17.    REF () BYTE        RVB_VALUE,
  18.    REF () REF () BYTE RVRVB_VALUE);
  19.  
  20. ***PAGE
  21.  
  22. @******************************************************************************@
  23. @*                                                                            *@
  24. @* External procedure references                                              *@
  25. @*                                                                            *@
  26. @******************************************************************************@
  27.  
  28. EXT (<PREFIX "ICLCTM">)
  29. PROC
  30.    (INT,                                         @ ERROR_NUMBER                @
  31.     REF () BYTE,                                 @ ERROR_MESSAGE               @
  32.     REF INT,                                     @ MESSAGE_LENGTH              @
  33.     RESPONSE                                     @ RESPONSE                    @
  34.    )                                   CTM_GIVE_ERROR_MSG;
  35.  
  36. EXT (<PREFIX "ICLCTM">)
  37. PROC
  38.    (WORD,                                        @ TYPE                        @
  39.     WORD,                                        @ DESTINATION                 @
  40.     REF () BYTE,                                 @ MESSAGE                     @
  41.     RESPONSE                                     @ RESPONSE                    @
  42.    )                                   CTM_LOG;
  43.  
  44. EXT (<PREFIX "ICLCTM">)
  45. PROC
  46.    (LONG LONG WORD,                              @ TARGET_RESPONSE             @
  47.     INT                                          @ RESPONSE_TO_CTM_JS_CALL     @
  48.     )                                  CTM_STOP;
  49.  
  50. EXT (<PREFIX "ICLCTM">)
  51. PROC
  52.    (LONG WORD,                                   @ MESSAGE                     @
  53.     WORD,                                        @ FRAMES                      @
  54.     WORD,                                        @ PLTS                        @
  55.     REF () LONG WORD,                            @ ADDRESSES                   @
  56.     REF () REF () BYTE,                          @ AREAS                       @
  57.     WORD,                                        @ OPTIONS                     @
  58.     RESPONSE                                     @ RESPONSE                    @
  59.    )                                   CTM_DUMP;
  60.  
  61. EXT (<PREFIX "ICLCTM">)
  62. PROC
  63.    (WORD,                                        @ CONTINGENCY_CLASS           @
  64.     LONG WORD,                                   @ INTERRUPT_PROCEDURE         @
  65.     RESPONSE                                     @ RESPONSE                    @
  66.    )                                   CTM_INFORM;
  67.  
  68. EXT
  69. PROC
  70.    (INT,                                         @ TEXT_NUMBER                 @
  71.     REF () KMT_MTM_VALUES                        @ AREA                        @
  72.    ) INT                               KMT_SP_MTM;
  73.  
  74. ***PAGE
  75.  
  76. @******************************************************************************@
  77. @*                                                                            *@
  78. @* External data references                                                   *@
  79. @*                                                                            *@
  80. @******************************************************************************@
  81.  
  82. @ Constants: @
  83. @ ********** @
  84.  
  85. ***LINES(4)
  86.  
  87. @ Variables: @
  88. @ ********** @
  89.  
  90. EXT
  91. REF () BYTE KMT_DATA_AREA;
  92.  
  93. ***LINES(4)
  94.  
  95. @ Results: @
  96. @ ******** @
  97.  
  98. ***LINES(4)
  99.  
  100. ***PAGE
  101.  
  102. @******************************************************************************@
  103. @*                                                                            *@
  104. @* Procedure declarations                                                     *@
  105. @*                                                                            *@
  106. @******************************************************************************@
  107.  
  108. GLOBAL
  109. STATIC (<STATUS 5>)
  110. PROC
  111.    KMT_EH_LOG_ERROR IS (
  112.    INT                    RESULTCODE,
  113.    WORD                   DESTINATION,
  114.    REF () KMT_MTM_VALUES PARAMS,
  115.    LONG WORD              PE_CONTINGENCY_MESSAGE,
  116.    BOOL                   DUMP,
  117.    BOOL                   UNRECOVERABLE):
  118.  
  119. @******************************************************************************@
  120. @*                                                                            *@
  121. @* This procedure is used to log failing resultcodes to the job journal       *@
  122. @* and/or to the MAC screen and to produce UCG dumps.                         *@
  123. @* If RESULTCODE is non zero then a failure message will be generated using   *@
  124. @* the parameters in the list referenced by PARAMS and logged to the job      *@
  125. @* journal.                                                                   *@
  126. @* If DUMP is set TRUE then a UCG dump is produced. PE_CONTINGENCY_MESSAGE is *@
  127. @* used in conjunction with DUMP and must contain either zero or a program    *@
  128. @* error contingency message.                                                 *@
  129. @* If UNRECOVERABLE is set TRUE then the program will exit.                   *@
  130. @*                                                                            *@
  131. @******************************************************************************@
  132.  
  133. BEGIN
  134.    INT KMT_EH_SOFTWARE_ERROR IS 80101,
  135.        KMT_EH_ICL_RESULT     IS 80102;
  136.  
  137.    INT RC_DISCARDED,
  138.        MESSAGE_LENGTH;
  139.  
  140.    (120) BYTE ERROR_MESSAGE;
  141.  
  142.    REF () BYTE MESSAGE_REM;
  143.  
  144.    UNLESS
  145.       RESULTCODE EQ 0
  146.  
  147.    THEN
  148.       INT RC IS IF
  149.                    RESULTCODE LT 0
  150.                 THEN
  151.                    -RESULTCODE
  152.                 ELSE
  153.                    RESULTCODE
  154.                 FI;
  155.  
  156.       BOOL ICL_RESULTCODE IS ((RC LT 80000) OR (RC GT 89999));
  157.  
  158.       INT PARAMS_LENGTH IS IF
  159.                               PARAMS IS NIL
  160.                            THEN
  161.                               0
  162.                            ELSE
  163.                               LENGTH PARAMS
  164.                            FI;
  165.  
  166.       INT MTM_AREA_LENGTH IS PARAMS_LENGTH + IF
  167.                                                 ICL_RESULTCODE
  168.                                              THEN
  169.                                                 5
  170.                                              ELSE
  171.                                                 4
  172.                                               FI;
  173.  
  174.       (MTM_AREA_LENGTH) KMT_MTM_VALUES MTM_AREA;
  175.  
  176.       INT MTM_TEXT_NUMBER,
  177.           MTM_REPLY,
  178.           MTM_MESSAGE_LENGTH;
  179.  
  180.       (100) BYTE MTM_MESSAGE;
  181.  
  182.       (2) REF () BYTE MTM_RECALL_DATA;
  183.  
  184.       MTM_AREA (SIZE 4) := (MTM_MESSAGE
  185.                             AS KMT_MTM_VALUES.RVB_VALUE,
  186.                             MTM_MESSAGE_LENGTH
  187.                             AS KMT_MTM_VALUES.RI_VALUE,
  188.                             MTM_RECALL_DATA
  189.                             AS KMT_MTM_VALUES.RVRVB_VALUE,
  190.                             (L'PARAMS_LENGTH)
  191.                             AS KMT_MTM_VALUES.LI_VALUE);
  192.  
  193.       IF
  194.          ICL_RESULTCODE
  195.  
  196.       THEN                                       @ Use MTM text number         @
  197.                                                  @ KMT_EH_ICL_RESULT to expand @
  198.                                                  @ the error message passing   @
  199.                                                  @ the RESULTCODE as a         @
  200.                                                  @ parameter                   @
  201.          MTM_TEXT_NUMBER := KMT_EH_ICL_RESULT;
  202.          MTM_AREA(4) := (L'RESULTCODE) AS KMT_MTM_VALUES.LI_VALUE;
  203.  
  204.          IF
  205.             PARAMS_LENGTH GT 0
  206.          THEN
  207.             MTM_AREA(5::) := PARAMS
  208.          FI
  209.  
  210.       ELSE                                       @ Use RESULTCODE as the MTM   @
  211.                                                  @ text number to expand the   @
  212.                                                  @ error message               @
  213.          MTM_TEXT_NUMBER := RC;
  214.  
  215.          IF
  216.             PARAMS_LENGTH GT 0
  217.  
  218.          THEN
  219.             MTM_AREA(4::) := PARAMS
  220.          FI
  221.       FI;
  222.  
  223.       WHILE
  224.         (
  225.          MTM_REPLY := KMT_SP_MTM (MTM_TEXT_NUMBER,
  226.                                   MTM_AREA);
  227.  
  228.          IF
  229.             MTM_REPLY NE -2
  230.  
  231.          THEN                                    @ Expanded message returned   @
  232.             REF () BYTE MESSAGE IS IF
  233.                                       MTM_REPLY EQ -3
  234.                                    THEN          @ Returned in recall data     @
  235.                                       MTM_TEXT_NUMBER := 0;
  236.                                       MTM_RECALL_DATA(0)
  237.                                    ELSE          @  Returned in message buffer @
  238.                                       MTM_TEXT_NUMBER := MTM_REPLY;
  239.                                       MTM_MESSAGE(SIZE MTM_MESSAGE_LENGTH)
  240.                                    FI;
  241.  
  242.             CTM_LOG (3,
  243.                      DESTINATION,
  244.                      MESSAGE,
  245.                      RC_DISCARDED)
  246.  
  247.          ELSE
  248.             MTM_TEXT_NUMBER := 0
  249.          FI;
  250.  
  251.          MTM_TEXT_NUMBER NE 0
  252.         )
  253.       DO
  254.          SKIP
  255.       REPEAT;
  256.  
  257.       IF
  258.          ICL_RESULTCODE
  259.  
  260.                                                  @ Get ICL message text        @
  261.       AND
  262.         (
  263.          CTM_GIVE_ERROR_MSG (RC,
  264.                              ERROR_MESSAGE,
  265.                              MESSAGE_LENGTH,
  266.                              RC_DISCARDED);
  267.          RC_DISCARDED EQ 0
  268.         )
  269.  
  270.       AND
  271.          MESSAGE_LENGTH GT 10
  272.  
  273.                                                  @ Skip "**** ERROR "          @
  274.       AND
  275.         (
  276.          MESSAGE_REM := ERROR_MESSAGE(10 SIZE MESSAGE_LENGTH - 10);
  277.          NOT SCANUNQ (X'40',                     @ Look for start of text      @
  278.                       MESSAGE_REM,
  279.                       0,
  280.                       MESSAGE_REM)
  281.         )
  282.  
  283.       THEN                                       @ Message text exists for     @
  284.                                                  @ resultcode. Log to journal. @
  285.          CTM_LOG (3,
  286.                   DESTINATION,
  287.                   MESSAGE_REM,
  288.                   RC_DISCARDED)
  289.       FI
  290.    FI;
  291.  
  292.    IF
  293.       DUMP
  294.  
  295.    THEN
  296.       () LONG WORD ADDRESSES := DISPLAY (BDESC KMT_DATA_AREA);
  297.  
  298.       CTM_DUMP (PE_CONTINGENCY_MESSAGE,
  299.                 10,
  300.                 10,
  301.                 ADDRESSES,
  302.                 NIL,
  303.                 4,                               @ Dump in character and hex   @
  304.                 RC_DISCARDED)
  305.    FI;
  306.  
  307.    IF
  308.       UNRECOVERABLE
  309.  
  310.    THEN
  311.       CTM_STOP (L'L'W' RESULTCODE,
  312.                 -KMT_EH_SOFTWARE_ERROR)
  313.    FI
  314. END;                                   @ KMT_EH_LOG_ERROR                      @
  315.  
  316. ***PAGE
  317.  
  318. GLOBAL
  319. STATIC (<STATUS 5>)
  320. PROC
  321.    KMT_EH_PE_CONTINGENCY_HANDLER IS (
  322.    REF LONG WORD PE_CONTINGENCY_MESSAGE):
  323.  
  324. @******************************************************************************@
  325. @*                                                                            *@
  326. @* This procedure is used to handle program error contingencies. The procedure*@
  327. @* calls KMT_EH_LOG_ERROR to produce a UCG dump. All programs are treated as  *@
  328. @* unrecoverable.                                                             *@
  329. @* PE_CONTINGENCY_MESSAGE references an area containing the program error     *@
  330. @* contingency message.                                                       *@
  331. @*                                                                            *@
  332. @******************************************************************************@
  333.  
  334. BEGIN
  335.    INT KMT_EH_SOFTWARE_ERROR IS 80101;
  336.  
  337.    KMT_EH_LOG_ERROR (KMT_EH_SOFTWARE_ERROR,
  338.                      2,
  339.                      NIL,
  340.                      PE_CONTINGENCY_MESSAGE,
  341.                      TRUE,                       @ Produce UCG dump            @
  342.                      TRUE)                       @ Unrecoverable - Exit        @
  343. END;                                   @ KMT_EH_PE_CONTINGENCY_HANDLER         @
  344.  
  345. ***PAGE
  346.  
  347. GLOBAL
  348. STATIC (<STATUS 5>)
  349. PROC
  350.    KMT_EH_INFORM_PE_CONTINGENCY IS (
  351.    RESPONSE RESULT):
  352.  
  353. @******************************************************************************@
  354. @*                                                                            *@
  355. @* This procedure is used to associate the contingency procedure:             *@
  356. @* KMT_EH_PE_CONTINGENCY_HANDLER with the the program error contingcy class.  *@
  357. @*                                                                            *@
  358. @******************************************************************************@
  359.  
  360. BEGIN
  361.  
  362.    INT KMT_EH_SOFTWARE_ERROR IS 80101;
  363.  
  364.    CTM_INFORM (X'80000000',                      @ PE contingencies            @
  365.                PDESC KMT_EH_PE_CONTINGENCY_HANDLER,
  366.                RESULT);
  367.  
  368.    IF
  369.       RESULT GT 0
  370.  
  371.    THEN (<RARELY>)
  372.      (
  373.       () BYTE PROC_NAME := "KMT_EH_INFORM_PE_CONTINGENCY";
  374.  
  375.       () KMT_MTM_VALUES PARAMS := DISPLAY(PROC_NAME
  376.                                           AS KMT_MTM_VALUES.RVB_VALUE);
  377.  
  378.       KMT_EH_LOG_ERROR (RESULT,
  379.                         2,
  380.                         PARAMS,
  381.                         0,
  382.                         FALSE,
  383.                         FALSE);
  384.       RESULT := KMT_EH_SOFTWARE_ERROR
  385.      )
  386.  
  387.    ELSE                                          @ Ignore warnings             @
  388.       RESULT := 0
  389.    FI
  390. END;                                   @ KMT_EH_INFORM_PE_CONTINGENCY          @
  391.  
  392. ENDMODULE                              @ KMT_EH_MODULE                         @
  393.