runerr.pas

Turbo Pascal 6.0编译器源码

unit RunErr;

{$F+,S-,V-}

interface

procedure InitRunErr;

implementation

uses Objects, Drivers, VideoIO;

var

  SaveExit: Pointer;

procedure ExitRunErr;
var
  Params: array[0..2] of Longint;
  Str: string[79];
begin
  if ErrorAddr <> nil then
  begin
    DoneSysError;
    DoneEvents;
    DoneVideo;
    DoneVideoIO;
    case ExitCode of
      209:
        PrintStr('Fatal error: Disk or EMS I/O failure.'^M^J);
      255:
        PrintStr('Fatal error: Cannot create swap file.'^M^J);
    else
      begin
        Params[0] := ExitCode;
        Params[1] := PtrRec(ErrorAddr).Seg;
        Params[2] := PtrRec(ErrorAddr).Ofs;
        FormatStr(Str,
          'Internal error %d at %04x:%04x. Please report to Borland.'^M^J,
          Params);
        PrintStr(Str);
      end;
    end;
    ExitCode := 1;
    ErrorAddr := nil;
  end;
  ExitProc := SaveExit;
end;

procedure InitRunErr;
begin
  SaveExit := ExitProc;
  ExitProc := @ExitRunErr;
end;

end.