КИТА unofficial

Unit diagnost;

INTERFACE

Uses crt,us;

type jumprec=record
              spsave,bpsave:word;
              jmpptr:pointer;
             end;

Var 
oldexit:pointer;
    jumping:jumprec;

procedure userexit;far;

procedure setjmp(var jmpdest:jumprec);
InLine($5F/$26/$89/$25/$26/$89/
         $6D/$02/$E8/$00/$00/$58/$05/$0C/$00/$26/$89/$45/$04/$26/$8C/$4D/$06);

procedure longjmp(var  jmpdest:jumprec);
inline($5F/$07/$26/$8B/$25/$26/$8B/$6D/$02/$26/$FF/$6D/$04);

                    IMPLEMENTATION

{процедура наш обработчик исключительных ситуаций}
procedure userexit;
Const
      w3:word=1811;
      w4:word=2875;
var 
  txt:string;

begin
 case exitcode of
  1:txt:='Неверный номер функции';
  2:txt:='Не найден файл';
  3:txt:='Не найден путь';
  100:txt:='Ошибка чтения с диска';
  101:txt:='Ошибка записи на диск';
  106:txt:='Неверный числовой формат';
  150:txt:='Диск защищен от записи';
  152:txt:='Не готов диск';
  154:txt:='Ошибка в исходных данных';
  200:txt:='Деление на ноль';
  202:txt:='Переполнение стека';
  203:txt:='Переполнение кучи';
  205:txt:='Переполнение при операции с плавающей запятой';
  206:txt:='Исчезновение порядка при операции с плавающей запятой';
  207:txt:='Недопустимая операция с плавающей запятой';
  else txt:=' Ошибка процесса ';
 end;{case}

{показываем сообщение об ошибке в отдельном окошке}
 rame(19,7,61,13,15,4,' ! ОШИБКА ! ');
 window(lo(w3)+1,hi(w3)+1,lo(w4)+1,hi(w4)+1);
 textbackground(red);
 textcolor(white);
 clrscr;
 setnocursor;
 writeln(txt);
 writeln('Нажмите любую клавишу для продолжения');
 window(lo(w1)+1,hi(w1)+1,lo(w10)+1,hi(w10)+1);
 readkey;

{удаляем временные файлы, восстанавливаем стандартные настройки окружения}
 go_out;

{здесь выполняется переход на сохраненную точку}
 exitcode:=0;
 erroraddr:=nil;
 longjmp(jumping);
end;

{********************************************}

                    END.

Program main;
uses meny,textin,dos,crt,us,diagnost;
var casing,n:byte;
    s1,s2,total_s:string;
    epsilon:real;
    icount:integer;
begin

{здесь создаем точку сохранения состояния}
setjmp(jumping);
casing:=10;
exitproc:=@userexit;

{здесь выполняется какой-то код}
repeat
  menu(casing);
  menu_process(casing);
until (casing=253)or(casing=50);

{здесь восстанавливаем стандартный обработчик ошибок}
exitproc:=nil;
end.