?? SET (LISTCTS := OFF) ??
?? RIGHT := 110, LEFT := 1 ??
?? FMT (FORMAT := ON, keyw := upper, ident := lower) ??
?? NEWTITLE := 'NOS/VE: CYBIL Error Procedures' ??
?? NEWTITLE := '  Global System Declarations' ??
MODULE cym$error_processor;
{   PURPOSE:
{     The purpose of this module is to provide the CYBIL error procedures
{     in a manner compatible with NOS/VE.
{
{   DESIGN:
{     The procedures contained in this module are designed to execute in the
{     ring of their caller - execution bracket of 1, 13.
?? EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc OST$STACK_FRAME_SAVE_AREA
?? POP ??
*copyc oss$job_paged_literal
*copyc CYD$RUN_TIME_ERROR_CONDITION
?? TITLE := '  External Procedures' ??
?? EJECT ??
*copyc OSP$SET_STATUS_ABNORMAL
*copyc OSP$APPEND_STATUS_PARAMETER
*copyc OSP$APPEND_STATUS_INTEGER
*copyc OSP$SYSTEM_ERROR
*copyc PMP$CAUSE_CONDITION

*copyc PMP$ABORT
?? TITLE := '  append_address_to_message' ??
?? EJECT ??

  PROCEDURE append_address_to_message (address: ost$pva;
    VAR message {input, output} : ost$status);

    osp$append_status_integer (osc$status_parameter_delimiter, address.ring, 16, FALSE, message);
    osp$append_status_integer (' ', address.seg, 16, FALSE, message);
    osp$append_status_integer (' ', address.offset, 16, FALSE, message);
  PROCEND append_address_to_message;
?? TITLE := '  [XDCL, #GATE] cyp$nil' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] cyp$nil;

{     The purpose of this procedure is to process calls to a NIL
{     pointer to procedure.

    VAR
      nil_caller: ^ost$stack_frame_save_area,
      executing_ring: ost$ring,
      ignore_status: ost$status,
      status: ost$status;

    nil_caller := #previous_save_area ();
    osp$set_status_abnormal ('CY', cye$nil_called, '', status);
    append_address_to_message (nil_caller^.minimum_save_area.p_register.pva, status);
    pmp$cause_condition (cye$run_time_condition, ^status, ignore_status);

    CASE #ring (^executing_ring) OF
    = osc$tmtr_ring =
      osp$system_error ('R2 cyp$nil called', ^status);
    = osc$tsrv_ring .. osc$user_ring_4 =
      pmp$abort (status);
    CASEND;
  PROCEND cyp$nil;
?? TITLE := '  [XDCL, #GATE] cyp$error' ??
  ?? EJECT ??

  VAR
    err_message: [STATIC, oss$job_paged_literal, READ] array [0 .. 25] of string (24) := [
{} 'unequal string length   ',
{} 'adaptable length error  ',
{} 'subscript error         ',
{} 'range error             ',
{} 'undefined case          ',
{} 'reset_to error          ',
{} 'stack size error        ',
{} 'tag fixer error         ',
{} 'span fixer error        ',
{} 'length fixer error      ',
{} 'subrange fixer error    ',
{} 'division by zero        ',
{} 'mantissa error          ',
{} 'exponent error          ',
{} 'substring start error   ',
{} 'substring length error  ',
{} 'translate length error  ',
{} 'translate table overflow',
{} 'negative allocation     ',
{} 'wrong size expr for REP ',
{} 'nil pointer             ',
{} 'unselected CASE         ',
{} 'free of unalloc. block  ',
{} 'lower merge error       ',
{} 'upper merge error       ',
{} '                        '];

  TYPE
    mod_name = string (31);

  PROCEDURE [XDCL, #GATE] cyp$error (error_number: integer;
        line_number: integer;
        module_name_ptr: ^mod_name);

{   The purpose of this procedure is to process CYBIL runtime detected errors.
{
{       CYP$ERROR (ERROR, LINE_NUMBER, MODULE_NAME)
{
{ ERROR: (input) This parameter indicates the detected error.
{
{ LINE_NUMBER: (input) This parameter the line number within the module which
{       caused the runtime error.
{ MODULE_NAME: (input) This parameter specifies the module name.
{

    VAR
      executing_ring: ost$ring,
      ignore_status: ost$status,
      status: ost$status;


    osp$set_status_abnormal ('CY', cye$cybil_abort, err_message [error_number], status);
    osp$append_status_integer (osc$status_parameter_delimiter, line_number, 10, FALSE, status);
    osp$append_status_parameter (osc$status_parameter_delimiter, module_name_ptr^, status);
    pmp$cause_condition (cye$run_time_condition, ^status, ignore_status);

    CASE #ring (^executing_ring) OF
    = osc$tmtr_ring =
      osp$system_error ('R2 cyp$error called', ^status);
    = osc$tsrv_ring .. osc$user_ring_4 =
      pmp$abort (status);
    CASEND;
  PROCEND cyp$error;
MODEND cym$error_processor;
