?? RIGHT := 110 ??
*copy osd$default_pragmats
MODULE ocm$interrupt_and_error_handler;


  { Purpose: This module contains the following general interrupt and error handling routines:
  {
  {                   ocp$ignore_interupts;
  {                   ocp$abort
  {                   ocp$abort_if_abnormal_status
  {                   ocp$abort_if_segment_overflow
  {                   ocp$abort_if_premature_eof
  {                   ocp$abort_with_structure_error
  {                   ocp$internal_error



  { *copyc oct$interrupt_types
  { *copyc oce$interrupt_exceptions

  { *copyc clt$file
  { *copyc pmp$abort
  { *copyc pmp$cause_condition
  { *copyc pmt$condition
  { *copyc ost$stack_frame_save_area

  { *copyc osp$set_status_abnormal
  { *copyc osp$append_status_parameter
?? PUSH (LIST := OFF) ??
*copyc oct$interrupt_types
*copyc oce$interrupt_exceptions

*copyc clt$file
*copyc pmp$abort
*copyc pmp$cause_condition
*copyc pmt$condition
*copyc ost$stack_frame_save_area

*copyc osp$set_status_abnormal
*copyc osp$append_status_parameter
?? POP ??
?? NEWTITLE := 'OCP$IGNORE_INTERUPTS', EJECT ??




  VAR
    ocv$interupt_condition: [XDCL, READ] pmt$condition := [ifc$interactive_condition,
      ifc$terminate_break];




  PROCEDURE [XDCL] ocp$ignore_interupts (condition: pmt$condition;
        condition_information: ^pmt$condition_information;
        stack_frame_save_area: ^ost$stack_frame_save_area;
    VAR condition_status: ost$status);


    condition_status.normal := TRUE;


  PROCEND ocp$ignore_interupts;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$ABORT' ??
?? NEWTITLE := '  OCP$ABORT_IF_ABNORMAL_STATUS' ??
?? NEWTITLE := '  OCP$INTERNAL_ERROR', EJECT ??

  PROCEDURE [XDCL] ocp$abort (abort_status: ost$status);


    VAR
      return_status: ost$status;


    pmp$cause_condition (occ$abort_condition, ^abort_status, return_status);

    IF (NOT return_status.normal) THEN
      pmp$abort (abort_status);
    IFEND;


  PROCEND ocp$abort;
?? OLDTITLE ??




  PROCEDURE [XDCL] ocp$abort_if_abnormal_status (status: ost$status);


    IF NOT status.normal THEN
      ocp$abort (status);
    IFEND;


  PROCEND ocp$abort_if_abnormal_status;
?? OLDTITLE ??




  PROCEDURE [XDCL] ocp$internal_error (error_text: string ( * ));


    VAR
      abort_status: ost$status;


    osp$set_status_abnormal ('OC', oce$internal_error, error_text, abort_status);

    ocp$abort (abort_status);


  PROCEND ocp$internal_error;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$ABORT_IF_SEGMENT_OVERFLOW' ??
?? NEWTITLE := '  OCP$ABORT_IF_PREMATURE_EOF', ??
?? NEWTITLE := '  OCP$ABORT_WITH_STRUCTURE_ERROR', EJECT ??

  PROCEDURE [XDCL] ocp$abort_if_segment_overflow (segment_pointer: ^cell);

     VAR
       pointer: ^^cell;

    pointer := segment_pointer;

    IF (pointer^ = NIL) THEN
      ocp$internal_error ('Internal segment overflow')
    IFEND;

  PROCEND ocp$abort_if_segment_overflow;
?? OLDTITLE ??




  PROCEDURE [XDCL] ocp$abort_if_premature_eof (segment_pointer: ^cell;
        file: clt$file);

     VAR
       pointer: ^^cell,
       abort_status: ost$status;

    pointer := segment_pointer;

    IF (pointer^ = NIL) THEN
      osp$set_status_abnormal ('OC', oce$premature_eof_in_segment, file.local_file_name, abort_status);
      ocp$abort (abort_status);
    IFEND;

  PROCEND ocp$abort_if_premature_eof;
?? OLDTITLE ??




  PROCEDURE [XDCL] ocp$abort_with_structure_error (error: string ( * );
        file: clt$file);

    VAR
      abort_status: ost$status;

    osp$set_status_abnormal ('OC', oce$structure_error_in_segment, error, abort_status);
    osp$append_status_parameter (osc$status_parameter_delimiter, file.local_file_name, abort_status);

    ocp$abort (abort_status);

  PROCEND ocp$abort_with_structure_error;
?? OLDTITLE ??




MODEND ocm$interrupt_and_error_handler.

