Columbia Kermit

home *** CD-ROM | disk | FTP | other *** search

/ Columbia Kermit / kermit.zip / iclvme2900 / kmt_eh_module < prev next >

Wrap

Text File | 2020-01-01 | 14KB | 393 lines

MODULE KMT_EH_MODULE; @******************************************************************************@ @* *@ @* Mode definitions *@ @* *@ @******************************************************************************@ MODE KMT_MTM_VALUES IS ANY ( LONG WORD LW_VALUE, LONG INT LI_VALUE, REF WORD RW_VALUE, REF INT RI_VALUE, REF LONG WORD RLW_VALUE, REF LONG INT RLI_VALUE, REF () BYTE RVB_VALUE, REF () REF () BYTE RVRVB_VALUE); ***PAGE @******************************************************************************@ @* *@ @* External procedure references *@ @* *@ @******************************************************************************@ EXT (<PREFIX "ICLCTM">) PROC (INT, @ ERROR_NUMBER @ REF () BYTE, @ ERROR_MESSAGE @ REF INT, @ MESSAGE_LENGTH @ RESPONSE @ RESPONSE @ ) CTM_GIVE_ERROR_MSG; EXT (<PREFIX "ICLCTM">) PROC (WORD, @ TYPE @ WORD, @ DESTINATION @ REF () BYTE, @ MESSAGE @ RESPONSE @ RESPONSE @ ) CTM_LOG; EXT (<PREFIX "ICLCTM">) PROC (LONG LONG WORD, @ TARGET_RESPONSE @ INT @ RESPONSE_TO_CTM_JS_CALL @ ) CTM_STOP; EXT (<PREFIX "ICLCTM">) PROC (LONG WORD, @ MESSAGE @ WORD, @ FRAMES @ WORD, @ PLTS @ REF () LONG WORD, @ ADDRESSES @ REF () REF () BYTE, @ AREAS @ WORD, @ OPTIONS @ RESPONSE @ RESPONSE @ ) CTM_DUMP; EXT (<PREFIX "ICLCTM">) PROC (WORD, @ CONTINGENCY_CLASS @ LONG WORD, @ INTERRUPT_PROCEDURE @ RESPONSE @ RESPONSE @ ) CTM_INFORM; EXT PROC (INT, @ TEXT_NUMBER @ REF () KMT_MTM_VALUES @ AREA @ ) INT KMT_SP_MTM; ***PAGE @******************************************************************************@ @* *@ @* External data references *@ @* *@ @******************************************************************************@ @ Constants: @ @ ********** @ ***LINES(4) @ Variables: @ @ ********** @ EXT REF () BYTE KMT_DATA_AREA; ***LINES(4) @ Results: @ @ ******** @ ***LINES(4) ***PAGE @******************************************************************************@ @* *@ @* Procedure declarations *@ @* *@ @******************************************************************************@ GLOBAL STATIC (<STATUS 5>) PROC KMT_EH_LOG_ERROR IS ( INT RESULTCODE, WORD DESTINATION, REF () KMT_MTM_VALUES PARAMS, LONG WORD PE_CONTINGENCY_MESSAGE, BOOL DUMP, BOOL UNRECOVERABLE): @******************************************************************************@ @* *@ @* This procedure is used to log failing resultcodes to the job journal *@ @* and/or to the MAC screen and to produce UCG dumps. *@ @* If RESULTCODE is non zero then a failure message will be generated using *@ @* the parameters in the list referenced by PARAMS and logged to the job *@ @* journal. *@ @* If DUMP is set TRUE then a UCG dump is produced. PE_CONTINGENCY_MESSAGE is *@ @* used in conjunction with DUMP and must contain either zero or a program *@ @* error contingency message. *@ @* If UNRECOVERABLE is set TRUE then the program will exit. *@ @* *@ @******************************************************************************@ BEGIN INT KMT_EH_SOFTWARE_ERROR IS 80101, KMT_EH_ICL_RESULT IS 80102; INT RC_DISCARDED, MESSAGE_LENGTH; (120) BYTE ERROR_MESSAGE; REF () BYTE MESSAGE_REM; UNLESS RESULTCODE EQ 0 THEN INT RC IS IF RESULTCODE LT 0 THEN -RESULTCODE ELSE RESULTCODE FI; BOOL ICL_RESULTCODE IS ((RC LT 80000) OR (RC GT 89999)); INT PARAMS_LENGTH IS IF PARAMS IS NIL THEN 0 ELSE LENGTH PARAMS FI; INT MTM_AREA_LENGTH IS PARAMS_LENGTH + IF ICL_RESULTCODE THEN 5 ELSE 4 FI; (MTM_AREA_LENGTH) KMT_MTM_VALUES MTM_AREA; INT MTM_TEXT_NUMBER, MTM_REPLY, MTM_MESSAGE_LENGTH; (100) BYTE MTM_MESSAGE; (2) REF () BYTE MTM_RECALL_DATA; MTM_AREA (SIZE 4) := (MTM_MESSAGE AS KMT_MTM_VALUES.RVB_VALUE, MTM_MESSAGE_LENGTH AS KMT_MTM_VALUES.RI_VALUE, MTM_RECALL_DATA AS KMT_MTM_VALUES.RVRVB_VALUE, (L'PARAMS_LENGTH) AS KMT_MTM_VALUES.LI_VALUE); IF ICL_RESULTCODE THEN @ Use MTM text number @ @ KMT_EH_ICL_RESULT to expand @ @ the error message passing @ @ the RESULTCODE as a @ @ parameter @ MTM_TEXT_NUMBER := KMT_EH_ICL_RESULT; MTM_AREA(4) := (L'RESULTCODE) AS KMT_MTM_VALUES.LI_VALUE; IF PARAMS_LENGTH GT 0 THEN MTM_AREA(5::) := PARAMS FI ELSE @ Use RESULTCODE as the MTM @ @ text number to expand the @ @ error message @ MTM_TEXT_NUMBER := RC; IF PARAMS_LENGTH GT 0 THEN MTM_AREA(4::) := PARAMS FI FI; WHILE ( MTM_REPLY := KMT_SP_MTM (MTM_TEXT_NUMBER, MTM_AREA); IF MTM_REPLY NE -2 THEN @ Expanded message returned @ REF () BYTE MESSAGE IS IF MTM_REPLY EQ -3 THEN @ Returned in recall data @ MTM_TEXT_NUMBER := 0; MTM_RECALL_DATA(0) ELSE @ Returned in message buffer @ MTM_TEXT_NUMBER := MTM_REPLY; MTM_MESSAGE(SIZE MTM_MESSAGE_LENGTH) FI; CTM_LOG (3, DESTINATION, MESSAGE, RC_DISCARDED) ELSE MTM_TEXT_NUMBER := 0 FI; MTM_TEXT_NUMBER NE 0 ) DO SKIP REPEAT; IF ICL_RESULTCODE @ Get ICL message text @ AND ( CTM_GIVE_ERROR_MSG (RC, ERROR_MESSAGE, MESSAGE_LENGTH, RC_DISCARDED); RC_DISCARDED EQ 0 ) AND MESSAGE_LENGTH GT 10 @ Skip "**** ERROR " @ AND ( MESSAGE_REM := ERROR_MESSAGE(10 SIZE MESSAGE_LENGTH - 10); NOT SCANUNQ (X'40', @ Look for start of text @ MESSAGE_REM, 0, MESSAGE_REM) ) THEN @ Message text exists for @ @ resultcode. Log to journal. @ CTM_LOG (3, DESTINATION, MESSAGE_REM, RC_DISCARDED) FI FI; IF DUMP THEN () LONG WORD ADDRESSES := DISPLAY (BDESC KMT_DATA_AREA); CTM_DUMP (PE_CONTINGENCY_MESSAGE, 10, 10, ADDRESSES, NIL, 4, @ Dump in character and hex @ RC_DISCARDED) FI; IF UNRECOVERABLE THEN CTM_STOP (L'L'W' RESULTCODE, -KMT_EH_SOFTWARE_ERROR) FI END; @ KMT_EH_LOG_ERROR @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_EH_PE_CONTINGENCY_HANDLER IS ( REF LONG WORD PE_CONTINGENCY_MESSAGE): @******************************************************************************@ @* *@ @* This procedure is used to handle program error contingencies. The procedure*@ @* calls KMT_EH_LOG_ERROR to produce a UCG dump. All programs are treated as *@ @* unrecoverable. *@ @* PE_CONTINGENCY_MESSAGE references an area containing the program error *@ @* contingency message. *@ @* *@ @******************************************************************************@ BEGIN INT KMT_EH_SOFTWARE_ERROR IS 80101; KMT_EH_LOG_ERROR (KMT_EH_SOFTWARE_ERROR, 2, NIL, PE_CONTINGENCY_MESSAGE, TRUE, @ Produce UCG dump @ TRUE) @ Unrecoverable - Exit @ END; @ KMT_EH_PE_CONTINGENCY_HANDLER @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_EH_INFORM_PE_CONTINGENCY IS ( RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to associate the contingency procedure: *@ @* KMT_EH_PE_CONTINGENCY_HANDLER with the the program error contingcy class. *@ @* *@ @******************************************************************************@ BEGIN INT KMT_EH_SOFTWARE_ERROR IS 80101; CTM_INFORM (X'80000000', @ PE contingencies @ PDESC KMT_EH_PE_CONTINGENCY_HANDLER, RESULT); IF RESULT GT 0 THEN (<RARELY>) ( () BYTE PROC_NAME := "KMT_EH_INFORM_PE_CONTINGENCY"; () KMT_MTM_VALUES PARAMS := DISPLAY(PROC_NAME AS KMT_MTM_VALUES.RVB_VALUE); KMT_EH_LOG_ERROR (RESULT, 2, PARAMS, 0, FALSE, FALSE); RESULT := KMT_EH_SOFTWARE_ERROR ) ELSE @ Ignore warnings @ RESULT := 0 FI END; @ KMT_EH_INFORM_PE_CONTINGENCY @ ENDMODULE @ KMT_EH_MODULE @