compiler.pas

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

unit Compiler;

interface

uses
  SysUtils, Classes, Assembler, Parser, Math, Errors, Common;

type

  TCompiler = class
  public
    Coder: TAsm;
    Format: String;
    Parser: TParser;
    Title: String;
    constructor Create;
    function GetString(Str: String; Ret: Boolean = False): String;
    procedure Compile(Input,Output: String);
    function GetRealFilename(Str: String): String;
    destructor Destroy; override;
  end;

implementation

function TCompiler.GetRealFilename(Str: String): String;
begin
  if Pos('''',Str) > 0 then
    result := GetString(Str,True)
  else
  begin
    if FileExists(Str+LibEx) then
      result := Str+LibEx;
  end;
end;

constructor TCompiler.Create;
begin
  inherited;
  Coder := TAsm.Create;
  Parser := TParser.Create;
  Coder.Parser := @Parser;
end;

function TCompiler.GetString(Str: String; Ret: Boolean = False): String;
var
  S: String;
  i,lp,ex: Integer;
  inStr, LastStr: Boolean;
begin
  lp := 1;
  inStr := False;
  LastStr := False;
  for i := 1 to Length(Str) do
  begin
    if Str[i] = '''' then
    begin
      if inStr then S := S + Copy(Str,lp,i-lp);
      lp := i+1;
      inStr := not inStr;
      if not inStr then LastStr := True
      else LastStr := False;
    end
    else if ((Str[i] = '+') or (i = Length(Str))) and not inStr then
    begin
      ex := 0;
      if i = Length(Str) then ex := 1;
      if not LastStr then
      begin
        if IsNumeric(Copy(Str,lp,i-lp+ex)) then
        begin
          S := S + Char(StrToInt(Copy(Str,lp,i-lp+ex)));
        end
        else
        begin
          if Coder.IsSymbol(Coder.CurrFunc+Copy(Str,lp,i-lp+ex)) then
          begin
            if not ret then
            begin
            Coder.AddOffset(Coder.AddData(S));
            Coder.AddOffset(Coder.GetSymbol(Coder.CurrFunc+Copy(Str,lp,i-lp+ex)).Offset);
            S := '';
            end;
          end
          else if Coder.IsSymbol(Copy(Str,lp,i-lp+ex)) then
          begin
            if not ret then
            begin
            Coder.AddOffset(Coder.AddData(S));
            Coder.AddOffset(Coder.GetSymbol(Copy(Str,lp,i-lp+ex)).Offset);
            S := '';
            end;
          end
          else if Coder.Equs.IndexOf(Copy(Str,lp,i-lp+ex)) > -1 then
              S := S + Char(Coder.GetEqu(Copy(Str,lp,i-lp+ex)))
          else if LowerCase(Copy(Str,lp,i-lp+ex)) = 'crlf' then
              S := S + #13#10
          else
            Coder.WriteMsg(NotConstant);
        end;
      end;
      LastStr := False;
      lp := i+1;
    end;
  end;
  result := S;
  if not (S = '') and not ret then
    Coder.AddOffset(Coder.AddData(S));
end;

procedure TCompiler.Compile(Input,Output: String);
  var
    i,cnt,ii,lc,lex: Integer;
    pr: TParser;
    tmp, val: String;
    X: Array[0..9] of Byte;
    hb,he: Boolean;
    
  procedure NotReturn;
  begin
    if PPart(Parser.Parts[i]).SAssign <> '' then
      Parser.AddMsg(NotReturnAnyData,PPart(Parser.Parts[i]).CurrFile,PPart(Parser.Parts[i]).LineNum,False);
  end;
  procedure NotExtra;
  begin
    if PPart(Parser.Parts[i]).Extra <> '' then
      Parser.AddMsg(ExtraNotAvailable,PPart(Parser.Parts[i]).CurrFile,PPart(Parser.Parts[i]).LineNum,False);
  end;
  procedure IncludeFile(Filename: String);
  begin
    if FileExists(GetRealFilename(Filename)) then
    begin
      pr := TParser.Create;
      pr.Parse(GetRealFilename(Filename));
      Parser.Parts.InsertItems(i,pr.Parts);
      cnt := Parser.Parts.Count;
      pr.Free;
      PPart(Parser.Parts[i]).Done := True;
      i := i - 1;
    end
    else
      Parser.AddMsg('File not found',PPart(Parser.Parts[i]).CurrFile,PPart(Parser.Parts[i]).LineNum);
  end;
begin
  Parser.Parse(Input);
  i := 0;
  lc := 0;
  lex := 0;
  hb := False;
  he := False;
  cnt := Parser.Parts.Count;
  Coder.CurrSize := ss16;
  while i < cnt do
  begin
    Parser.CanMsg := True;
    if PPart(Parser.Parts[i]).Func = 'program' then
    begin
      NotReturn;
      NotExtra;
      if PPart(Parser.Parts[i]).ParamCount = 2 then
      begin
        Format := LowerCase(PPart(Parser.Parts[i]).Params[1]);
        Title := PPart(Parser.Parts[i]).Params[0];
        if Format = 'dos.mz' then
        begin
          Coder.FuncBegin;
          Coder.AsmJmp(0,Coder.CurrSize);
          Coder.AddFixup(Coder.Size(True),Coder.CurrSize,ftJump,'start');
        end
        else if (Format = 'windows.gui') or (Format = 'windows.gui') then
        begin
          Coder.CurrSize := ss32;
          Coder.AsmJmp(0,Coder.CurrSize);
          Coder.AddFixup(Coder.Size(True),Coder.CurrSize,ftJump,'start');
        end;
        if Format <> 'none' then
        begin
          Coder.AddOffset(Coder.AddData(Title));
          Coder.AddSymbol('app.name',Coder.CurrSize,stConstant);
        end;
        PPart(Parser.Parts[i]).Offset := Coder.Size(True);
        PPart(Parser.Parts[i]).Done := True;
      end
      else
        Parser.AddMsg(WrongCountOfArgs,PPart(Parser.Parts[i]).CurrFile,PPart(Parser.Parts[i]).LineNum);
    end
    else if PPart(Parser.Parts[i]).Func = 'include' then
    begin
      NotReturn;
      NotExtra;
      if PPart(Parser.Parts[i]).ParamCount = 1 then
      begin
        IncludeFile(PPart(Parser.Parts[i]).Params[0]);
      end
      else
        Parser.AddMsg(WrongCountOfArgs,PPart(Parser.Parts[i]).CurrFile,PPart(Parser.Parts[i]).LineNum);
    end
    else if PPart(Parser.Parts[i]).Func = 'uses' then
    begin
      NotReturn;
      NotExtra;
      if PPart(Parser.Parts[i]).ParamCount >= 1 then
      begin
        for ii := 0 to PPart(Parser.Parts[i]).ParamCount - 1 do
        begin
          IncludeFile(PPart(Parser.Parts[i]).Params[ii]);
        end;
      end
      else
        Parser.AddMsg(WrongCountOfArgs,PPart(Parser.Parts[i]).CurrFile,PPart(Parser.Parts[i]).LineNum);
    end
    else if PPart(Parser.Parts[i]).Func = 'const' then
    begin
      NotReturn;
      NotExtra;
      if PPart(Parser.Parts[i]).ParamCount = 2 then
      begin
        GetString(PPart(Parser.Parts[i]).Params[1]);
        Coder.AddSymbol(PPart(Parser.Parts[i]).Params[0],Coder.CurrSize,stConstant);
        PPart(Parser.Parts[i]).Done := True;
      end
      else
        Parser.AddMsg(WrongCountOfArgs,PPart(Parser.Parts[i]).CurrFile,PPart(Parser.Parts[i]).LineNum);
    end
    else if PPart(Parser.Parts[i]).Func = 'equ' then
    begin
      NotReturn;
      NotExtra;
      if PPart(Parser.Parts[i]).ParamCount = 2 then
      begin
        Coder.AddEqu(PPart(Parser.Parts[i]).Params[0],Coder.GetNumber(PPart(Parser.Parts[i]).Params[1]));
        PPart(Parser.Parts[i]).Done := True;
      end
      else
        Parser.AddMsg(WrongCountOfArgs,PPart(Parser.Parts[i]).CurrFile,PPart(Parser.Parts[i]).LineNum);
    end
    else if PPart(Parser.Parts[i]).Func = 'alias' then
    begin
      NotReturn;
      NotExtra;
      if PPart(Parser.Parts[i]).ParamCount = 2 then
      begin
        if Pos('@',PPart(Parser.Parts[i]).Params[1]) > 0 then
        begin
          Coder.AddAlias(PPart(Parser.Parts[i]).Params[0],PPart(Parser.Parts[i]).Params[1]);
        end
        else
          Parser.AddMsg(WrongAlias,PPart(Parser.Parts[i]).CurrFile,PPart(Parser.Parts[i]).LineNum);
        PPart(Parser.Parts[i]).Done := True;
      end
      else
        Parser.AddMsg(WrongCountOfArgs,PPart(Parser.Parts[i]).CurrFile,PPart(Parser.Parts[i]).LineNum);
    end
    else if PPart(Parser.Parts[i]).Func = 'var' then
    begin
      NotReturn;
      NotExtra;
      if PPart(Parser.Parts[i]).ParamCount = 2 then
      begin
        Coder.FuncVar(PPart(Parser.Parts[i]).Params[0],PPart(Parser.Parts[i]).Params[1],'0');
        PPart(Parser.Parts[i]).Done := True;
      end
      else if PPart(Parser.Parts[i]).ParamCount = 3 then
      begin
        Coder.FuncVar(PPart(Parser.Parts[i]).Params[0],PPart(Parser.Parts[i]).Params[1],PPart(Parser.Parts[i]).Params[2]);
        PPart(Parser.Parts[i]).Done := True;
      end
      else
        Parser.AddMsg(WrongCountOfArgs,PPart(Parser.Parts[i]).CurrFile,PPart(Parser.Parts[i]).LineNum);
    end
    else if Coder.Alias.IndexOf(LowerCase(PPart(Parser.Parts[i]).Func)) > -1 then
    begin
      tmp := Coder.GetAlias(PPart(Parser.Parts[i]).Func);
      PPart(Parser.Parts[i]).DLL := Copy(tmp,1,Pos('@',tmp)-1);
      PPart(Parser.Parts[i]).Func := Copy(tmp,Pos('@',tmp)+1,Length(tmp));
      PPart(Parser.Parts[i]).PartType := ptDLLFunc;
    end;
    i := i + 1;
  end;
  for i := 0 to Parser.Parts.Count - 1 do
  begin
   Parser.CanMsg := True;
   Coder.CurrFile := PPart(Parser.Parts[i]).CurrFile;
   Coder.CurrLine := PPart(Parser.Parts[i]).LineNum;
   if PPart(Parser.Parts[i]).PartType = ptLabel then
   begin
     if PPart(Parser.Parts[i]).Extra = '@@' then
     begin
       lex := lex + 1;
       Coder.AddSymbol('NN'+IntToStr(lex),Coder.CurrSize,stLabel,Coder.Size(True));
     end
     else
       Coder.AddSymbol(PPart(Parser.Parts[i]).Extra,Coder.CurrSize,stLabel,Coder.Size(True));
   end
   else if PPart(Parser.Parts[i]).PartType = ptFuncLabel then
    begin
      Coder.AddSymbol(PPart(Parser.Parts[i]).Func,Coder.CurrSize,stLabel,Coder.Size(True));
      Coder.CurrFunc := LowerCase(PPart(Parser.Parts[i]).Func)+'.';
      for ii := 0 to PPart(Parser.Parts[i]).ParamCount - 1 do
      begin
        tmp := PPart(Parser.Parts[i]).Params[ii];
        val := Copy(tmp,Pos(':',tmp)+1,Length(tmp));
        tmp := Copy(tmp,1,Pos(':',tmp)-1);
        Coder.FuncVar(tmp,val,'0');