viking.dpr

一个编译器源代码。用法看里面的“使用说明”

program Viking;

{$APPTYPE CONSOLE}
{$DEFINE NOTGUI}

uses
  SysUtils,
  Classes,
  Windows,
  ShellAPI,
  Assembler in 'Assembler.pas',
  Compiler in 'Compiler.pas',
  Parser in 'Parser.pas',
  Errors in 'Errors.pas',
  Debug in 'Debug.pas',
  Common in 'Common.pas';

const
  Version = '2.1';

var
  Coder: TCompiler;
  StartTime, EndTime, Freq: Int64;
  Input, Output, Cmd, TimeStr, X: String;
  RunAfterCompile, ShowErrors, ShowWarnings, PauseAfter, DebugAfter: Boolean;
  
  procedure DoCompile(WithParams: Boolean);
  var
    i: Integer;
  begin
    ShowErrors := True;
    ShowWarnings := True;
    PauseAfter := False;
    DebugAfter := False;
    RunAfterCompile := False;
    if WithParams then
    begin
    for i := 1 to ParamCount do
    begin
      if Input = '' then Input := ParamStr(i)
      else if Output = '' then Output := ParamStr(i)
      else
      begin
        if ParamStr(i) = '-d' then
          DebugAfter := True
        else if ParamStr(i) = '-e' then
          ShowErrors := False
        else if ParamStr(i) = '-r' then
          RunAfterCompile := True
        else if ParamStr(i) = '-w' then
          ShowWarnings := False
        else if ParamStr(i) = '-p' then
          PauseAfter := True
        else if Copy(ParamStr(i),1,3) = '-c:' then
        begin
          RunAfterCompile := True;
          Cmd := Copy(ParamStr(i),4,Length(ParamStr(i)));
          WriteLn(Cmd);
        end;
      end;
    end;
    WriteLn('Source: ' + ExtractFileName(Input));
    WriteLn('Binary: ' + ExtractFileName(Output));
    end;

    Write(#13#10);
    QueryPerformanceFrequency(Freq);
    QueryPerformanceCounter(StartTime);

    Coder := TCompiler.Create;
    if FileExists(Input) then
      Coder.Compile(Input,Output)
    else
    begin
      WriteLn('Fatal error: The source file ('+Input+') wasn''t found.');
      Coder.Coder.FormatterError := True;
    end;

    QueryPerformanceCounter(EndTime);
    TimeStr := Format('%.3f',[(EndTime - StartTime) / Freq]);

    if ShowErrors then
    begin
      for i := 0 to Coder.Parser.Errors.Count - 1 do
      begin
        if PMsg(Coder.Parser.Errors[i]).CurrFile = '' then
          WriteLn('Error: '+PMsg(Coder.Parser.Errors[i]).Description+'.')
        else if PMsg(Coder.Parser.Errors[i]).CurrFile = Input then
          WriteLn('Error['+IntToStr(PMsg(Coder.Parser.Errors[i]).LineNum)+']: '+PMsg(Coder.Parser.Errors[i]).Description+'.')
        else
          WriteLn('Error in '+ExtractFileName(PMsg(Coder.Parser.Errors[i]).CurrFile)+'['+IntToStr(PMsg(Coder.Parser.Errors[i]).LineNum)+']: '+PMsg(Coder.Parser.Errors[i]).Description+'.');
      end;
    end;
    if ShowWarnings then
    begin
      for i := 0 to Coder.Parser.Warnings.Count - 1 do
      begin
        if PMsg(Coder.Parser.Warnings[i]).CurrFile = '' then
          WriteLn('Warning: '+PMsg(Coder.Parser.Warnings[i]).Description+'.')
        else if PMsg(Coder.Parser.Warnings[i]).CurrFile = Input then
          WriteLn('Warning['+IntToStr(PMsg(Coder.Parser.Warnings[i]).LineNum)+']: '+PMsg(Coder.Parser.Warnings[i]).Description+'.')
        else
          WriteLn('Warning in '+ExtractFileName(PMsg(Coder.Parser.Warnings[i]).CurrFile)+'['+IntToStr(PMsg(Coder.Parser.Warnings[i]).LineNum)+']: '+PMsg(Coder.Parser.Warnings[i]).Description+'.');
      end;
    end;
    if (Coder.Parser.Errors.Count = 0) and not Coder.Coder.FormatterError then
    begin
      WriteLn('Successfully completed in ' + TimeStr + ' seconds. '+#13#10+IntToStr(Coder.Coder.Size((LowerCase(Coder.Format) <> 'none'),True,True))+' bytes written.');
    end
    else
    begin
      if FileExists(Output) then DeleteFile(PChar(Output));
      WriteLn(#13#10+'Could not complete the compilation process.');
      if not Coder.Coder.FormatterError then WriteLn(IntToStr(Coder.Parser.Errors.Count)+' errors and '+IntToStr(Coder.Parser.Warnings.Count)+' warnings occured.');
    end;

    if RunAfterCompile and (Coder.Parser.Errors.Count = 0) and not Coder.Coder.FormatterError then
    begin
      if (LowerCase(Coder.Format) = 'windows.gui') or (LowerCase(Coder.Format) = 'windows.console') then
      begin
        WriteLn(#13#10+'Executing program...');
        QueryPerformanceFrequency(Freq);
        QueryPerformanceCounter(StartTime);
        AppDebug(Output,Cmd,DebugAfter);
        QueryPerformanceCounter(EndTime);
        TimeStr := Format('%.3f',[(EndTime - StartTime) / Freq]);
        WriteLn(#13#10+'Done in '+TimeStr+' seconds.');
      end
      else
      begin
        WriteLn(#13#10+'Error: Can only run and debug Windows applications.');
      end;
    end;
    Coder.Free;

    if PauseAfter or Not WithParams then
    begin
      Write('Press enter to exit...');
      Read(X);
    end;
  end;
  
begin
  WriteLn('Viking Compiler Version '+Version+#13#10+
          'Copyright (c) Viking Software 2003, Inc.'+#13#10+
          'All rights reserved.'+#13#10);

  if ParamCount = 0 then
  begin
    Write('Source: ');
    ReadLn(Input);
    Write('Binary: ');
    ReadLn(Output);
    DoCompile(False);
  end
  else if (ParamCount = 1) and (ParamStr(1) = '-h') then
  begin
    WriteLn('Usage: viking.exe source binary [options]'+#13#10+
            '       -c:[str] Sets the parameters to the output-file, will'+#13#10+
            '                automatically run the program after compile.'+#13#10+
            '       -d       Debug after compile.'+#13#10+
            '       -e       Don''t show error messages.'+#13#10+
            '       -h       With no other params, this will show this help-'+#13#10+
            '                screen'+#13#10+
            '       -p       Pause after compile/run.'+#13#10+
            '       -r       Run after compile.'+#13#10+
            '       -w       Don''t show warnings.');
  end
  else
  begin
    DoCompile(True);
  end;
end.