{*  einschalten : SET_ERROR_HANDLER (ON);      *}
{*    Fehlerbehandlung durch ERROR_HANDLER.    *}
{*    Programm laeuft weiter. Potentielle      *}
{*    Fehler koennen mit ERROR_NUM abgefragt   *}
{*    werden.                                  *}
{*  ausschalten : SET_ERROR_HANDLER (OFF);     *}
{*    Run-Time-Fehler fuehren zum Programm-    *}
{*    abbruch. (Default)                       *}
{*                                             *}
{*  Function ERROR_NUM :                       *}
{*    0 : kein Fehler,                         *}
{*    sonst TURBO PASCAL Fehlernummer          *}
const
  ON = true;
  OFF = false;

var
ERROR_CODE : byte;


procedure WARM_START;        { restart program }
begin
  inline ($C3/$00/$01);      { JP $0100 }
end; { WARM_START }


function ERROR_HANDLER : real;
begin
  inline ($32/ERROR_CODE);   { LD (ERROR_CODE),A }
  ERROR_HANDLER := 0.;
  case ERROR_CODE of
  $01 : ;           { Floating point overflow }
  $02 : ;           { division by 0 }
  $03 : ;           { sqrt argument < 0 }
  $04 : ;           { ln argument <= 0 }
  $10 : ;           { string length error }
  $11 : ;           { invalid string index }
  $90 : ;           { invalid array index }
  $91 : ;           { invalid scalar/subrange }
  $92 : ;           { out of integer range }
  $FF : WARM_START; { heap/stack collision }
  else
    writeln (' unknown run-time error ', ERROR_CODE);
    halt;
  end;
end; { ERROR_HANDLER }

function ERROR_NUM : byte;
begin
  ERROR_NUM := ERROR_CODE;
  ERROR_CODE := 0;
end;

procedure SET_ERROR_HANDLER (SWITCH : boolean);
const
  JUMP = $C3;
type
  JUMP_VECTOR = record
                  OPCODE : byte;
                  ADR : integer;
                end;
var

(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *)
(* Fuer Version 3.0 Adresse $1F75 aendern in $2029 *)
(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *)

  RUN_TIME_ERROR : JUMP_VECTOR absolute $1F75;

(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *)

  RUN_TIME_ERROR_BAK : JUMP_VECTOR;
begin
  if SWITCH then
  begin
    ERROR_CODE := 0;
    RUN_TIME_ERROR_BAK := RUN_TIME_ERROR;
    RUN_TIME_ERROR.OPCODE := JUMP;
    RUN_TIME_ERROR.ADR := addr (ERROR_HANDLER);
  end
  else RUN_TIME_ERROR := RUN_TIME_ERROR_BAK;
end;