{+-------------------------------------------------------+

 | Программа иллюстрирует механизм выхода из процедуры   |

 |   завершения в нужную точку программы.В программе     |

 | осуществляется ввод произвольного целого числа, затем |

 |   вычисляется корень квадратный из него и находится   |

 | обратная ему величина.Для завершения работы программы |

 |             следует ввести единицу.                   |

 |+------------------------------------------------------+}

Uses F_Jump;

var

  OldExit: Pointer;  {Старое значение переменной ExitProc}

  Jump   : JumpRec;  {Сохранение точки выхода}

  rr      : Real;     {Вспомогательная переменная}

label

  Loop;

Procedure MyExit; Far;

  {Эта процедура обрабатывает исключительную ситуацию}

begin

  LongJump(Jump)

end;  {MyExit}

begin

  OldExit := ExitProc;

  repeat

Loop:                   {Точка повторения ввода}

    if ErrorAddr <> NIL then

      begin

        Write('Повторите ввод числа: ');

        ErrorAddr := NIL;

        ExitCode := 0

      end

    else

      Write('Введите число: ');

    ExitProc := @MyExit;        {Адрес процедуры выхода}

    SetJump(Jump);              {Контролируем ввод данных}

    if ErrorAddr <> NIL then

      begin

        WriteLn('Ошибка при вводе вещественного числа');

        Goto Loop

      end

    else

      ReadLn(rr);

    SetJump(Jump);             {Контролируем извлечение корня}

    if ErrorAddr <> NIL then

      begin

        WriteLn('Ошибка при извлечении корня');

        Goto Loop

      end

    else

      rr := sqrt(rr);

    SetJump(Jump);              {Контролируем деление}

    if ErrorAddr <> NIL then

      begin

        WriteLn('Ошибка при делении чисел');

        Goto Loop

      end

    else

      rr := 1/rr;

    WriteLn(r:20:10)

  until rr = 1;

  ExitProc := OldExit       {Нормальный выход}

end.

unit Except;

 

interface

type

  Try = record

    _sp, _bp: Word;

    _farptr: Pointer;

  end;

 

procedure SetExcept(var dest: Try); inline (

$5f/$07/$26/$89/$25/$26/$89/$6d/$02/

$e8/$00/$00/$58/$05/$0c/$00/$26/$89/

$45/$04/$26/$8c/$4d/$06);

 

procedure ProceedExcept(var dest: Try); inline (

$5f/$07/$26/$8b/$25/$26/$8b/$6d/$02/

$26/$ff/$6d/$04);

 

implementation

 

end.

uses dos, crt, except;

 

var

  OldExit: Pointer;

  exc    : Try;

  r      : Real;

label

  l;

 

procedure NewExit; far;

begin

  ExitProc := @NewExit;

  ProceedExcept(exc);

end;

 

begin

  OldExit := ExitProc;

  ExitProc := @NewExit;

  repeat

  l:

      Writeln;

      Write('Enter number: ');

      SetExcept(exc);

      Readln(r);

      ErrorAddr := NIL;

      SetExcept(exc);

      if ErrorAddr <> NIL then

        Goto l;

      Writeln('100/',r,'= ',100.0/r);

  until (r=1);

  ExitProc := OldExit;

end.