unit uExit;

      {=================================================================}
      {                                                                 }
      {  Obsluha UEXIT                                                  }
      {                                                                 }
      {  Zaverecne nastaveni datovych struktur a hardware               }
      {                                                                 }
      {  (C) SofCon s.r.o.,                                             }
      {                                                                 }
      {=================================================================}

{$I Sets.inc}

interface

procedure SetAppExitProc; {nastavi vlastni ExitProc aplikace}

procedure AppExit;

{-----------------------------------------------------}
implementation
uses
  Kernel,
  LocGlb,
  GrWrite,
  NumToStr,
  XTKing_1;

procedure AppExit; { EXIT bez o.s. ReTOS }
{$ifdef VerPc}
var F:file;
{$endif}
begin
{$ifdef VerPc}
  {$i-}
  Assign(F,GlbFileName);
  Rewrite(F,1);
  if IOResult<>0 then
  begin
  {$ifdef DebError}
    WriteLnS('Nelze zapsat do souboru');
  {$endif}
    exit;
  end;

  BlockWrite(F,Glb^,SizeOf(tGlb));
  if IOResult<>0 then
  begin
  {$ifdef DebError}
    WriteLnS('Nelze zapsat do souboru');
  {$endif}
  end;
  {$i+}
{$endif}
end;

const
  SavePointer : Pointer = nil;

procedure MyExitProc; far;
begin
  ExitProc:=SavePointer;
  if ExitCode<>0 then
  with Glb^.gRStruct.CommonRstStruct do
  begin
    Inc(ARst);
    if ARst>MaxRst then
      ARst:=0;
    with  Rst[ARst] do
    begin
       rErr :=ExitCode;
       rAddr:=ErrorAddr;
       rPckTime:=GetPackTime;
       rStr :=RunningProcess;
    end;
{$ifdef DebError}
    WriteLnS('Error = '+WordStrDec(ExitCode,3)+', Addr = '+PtrToStr(ErrorAddr));
{$endif}

    AppExit;

{$ifdef VerMc}
   {$ifNdef DebStop}
    asm cli end; {WatchDog provede reset}
   {$endif}
    repeat
    until false;
{$endif}
  end;
end;

procedure SetAppExitProc;
begin
  SavePointer:=ExitProc;
  ExitProc:=@MyExitProc;
end;

end.