Компилятор в 13000 строк

Компилятор в 13000 строк

procedure TPrinterAST.PrintVarAssignVar(const VarAssignAST: TVarAssignAST);
var
  TypeFamily:TTypeFamily;
begin
  Assert(VarAssignAST<> nil, '98');
  TypeFamily:=SignatureTypeFamily(VarAssignAST.Signature);
  case TypeFamily of
  tfUndefine:  Compiler.Error.Add(194, '');  // Недопустимый тип
  tfOrdinal:   PrintVarAssignVar_Ordinal(VarAssignAST);
  tfReal:      PrintVarAssignVar_Real(VarAssignAST);
  tfBoolean:   PrintVarAssignVar_Ordinal(VarAssignAST);
  tfPointer:   PrintVarAssignVar_Ordinal(VarAssignAST);
  tfString:    PrintVarAssignVar_String(VarAssignAST);
  tfStructure: PrintVarAssignVar_Structure(VarAssignAST);
  end;
end;

procedure TPrinterAST.PrintRegAssignString(const Reg:Integer; const ImmConst: TImmConstAST);
var
  RegName:String;
  IndentDecl:TConstDeclAST;
begin
  Assert(ImmConst<> nil, '99');
  IndentDecl:=GentIndentForImmString(ImmConst._String);
  AddConstImm(ImmConst, IndentDecl);

  RegName:=GetRegName(Reg, GetTypeSize(IndentDecl._Type));
  PrintCmdAssign2(-4, RegName, IndentDecl.Indent, ToReg);    // -2-2 для ссылки
//  PrintCmdAssign('MOV', RegName, IndentDecl.Indent, ToReg);
end;

procedure TPrinterAST.PrintVarAssignString(const VarAssignAST: TVarAssignAST);
var
  RegName:String;
  IndentDecl:TVarDeclAST;
  Ofs:Integer;
  Signature:TSignatureAST;
  Signature2:TSignatureAST;
  IndentDecl1:TVarDeclAST;
  IndentDecl2:TConstDeclAST;
begin
  Assert(VarAssignAST<> nil, '100');
  Signature:=VarAssignAST.Signature;
  IndentDecl1:=Signature.IndentDeclRef as TVarDeclAST;

       case Signature.Designator.Kind of
       dkSignature:
          begin
            if VarAssignAST.Expression.Factor1.Kind=fkImmConst then
               begin
               IndentDecl2:=GentIndentForImmString(VarAssignAST.Expression.Factor1.ImmConst._String);
               AddConstImm(VarAssignAST, IndentDecl2);
               PrintCmdAssign2(0, 'EAX', IndentDecl2.Indent, ToReg);
//               PrintCmdAssign('LEA', 'EAX', IndentDecl2.Indent, ToReg);
               PrintPush('EAX');
               end  else
               begin
               IndentDecl:= VarAssignAST.Expression.Factor1.Signature.IndentDeclRef as TVarDeclAST;

               PrintCmdAssign2(0, 'EAX', IndentDecl.Indent, ToReg);
//               PrintCmdAssign('LEA', 'EAX', IndentDecl.Indent, ToReg);
               PrintPush('EAX');
               end;

            PrintCmdAssign2(0, 'EAX', IndentDecl1.Indent, ToReg);
//            PrintCmdAssign('LEA', 'EAX', IndentDecl1.Indent, ToReg);
            PrintPush('EAX');

            WriteLn(FFile,#9#9'CALL AssignString');
            Dec(SubStack, 2*PointerSize);
          end;
       dkDesignature: ;
       dkDesignatureDot:
          begin
          PrintCmdAssign2(0, 'ESI', Signature.IndentDeclRef.Indent, ToReg);
//          PrintCmdAssign('LEA', 'ESI', Signature.IndentDeclRef.Indent, ToReg);
          Ofs:=0;
          Signature2:=Signature;
          While  Signature2.Designator.Kind= dkDesignatureDot do
             begin
             Signature2:=Signature2.Designator.Signature;
             Ofs:=Ofs+GetFildOfs(Signature2);
             end;

          IndentDecl2:=GentIndentForImmString(VarAssignAST.Expression.Factor1.ImmConst._String);
          AddConstImm(VarAssignAST, IndentDecl2);

          PrintCmdAssign2(1, 'EAX', IndentDecl2.Indent, ToReg);
//          PrintCmdAssign('MOV', 'EAX', IndentDecl2.Indent, ToReg);
          PrintPush('EAX');

          WriteLn(FFile,#9#9'LEA EAX, [ESI+EDI]');
          PrintPush('EAX');

          WriteLn(FFile,#9#9'CALL AssignString');
          Dec(SubStack, 2*PointerSize);
          end;
       end; // case

end;

{© 2017 Pavia. All Rights Reserved, by Pavia.}
unit UParserImplementation;

interface

uses UCompiler, UAST, UFSM, UASTFabric, USimvler, UGramAnaliser,
  UParserDeclarations, UParserStatement, UParserAsm;

type
  TImplemtSectionParser = class(TParser)
  private
    { private declarations }
  protected
    { protected declarations }
  public
     DeclSectionParser:TDeclSectionParser;
     StatementParser:TStatementParser;
     ForeignAsmParser:TForeignAsmParser;
     constructor Create(TheCompiler:TCompiler); Overload;
     function Parse(Anchor:TSimvol):TImplimentaionAST;
     procedure ErrorWay(Anchor:TSimvol);
     procedure MainBlock(var Node:TNodeAST);
     procedure ImplFunction(var Node:TNodeAST);
     procedure ImplProcedure(var Node:TNodeAST);
     procedure AsmBlock(var Node: TNodeAST);
     procedure ParseAsm(var Node: TNodeAST);
     procedure NOP(var Node:TNodeAST);
     function  IsNop(var Proc): Boolean;

    { public declarations }
  published
    { published declarations }
  end;

implementation

{ TImplementationsParser }

constructor TImplemtSectionParser.Create(TheCompiler: TCompiler);
begin
inherited Create(TheCompiler);
StatementParser:=TStatementParser.Create(TheCompiler);
ForeignAsmParser:=TForeignAsmParser.Create(TheCompiler);
end;

procedure TImplemtSectionParser.ErrorWay(Anchor: TSimvol);
begin
  repeat
     ReadSimvol;
  until SimvolInArray(CurrentSimvol,[Anchor, TS(';'), TS('.'), EOFSimvol]);
  if CheckSimvol(TS(';')) then
     ReadSimvol;
end;

procedure TImplemtSectionParser.ImplFunction(var Node: TNodeAST);
var
  NHeading:TNodeAST;
  FuncImpAST:TFuncImpAST;
  LocalDecl:TDeclarationAST;
  CompaundStatement:TNodeAST;
  NAsmBlock:TNodeAST; 
begin
  FuncImpAST:=ASTFabric.FuncImpCreate;
    ASTFabric.ActivLeaf:=FuncImpAST;
      DeclSectionParser.FunctionHeading(NHeading);

      DeclSectionParser.ResultExist:=True;
      DeclSectionParser.ResultType:=(NHeading as TFuncDeclAST).result;
  FuncImpAST.FuncDecl:=NHeading as TFuncDeclAST;
      if  FuncImpAST.FuncDecl.Attr.Imp=faHoha then
          begin
          LocalDecl:=DeclSectionParser.Parse(TS('Begin'));
          FuncImpAST.LocalDec:=LocalDecl;
          StatementParser.ParseCompaundStatement(CompaundStatement);
          FuncImpAST.CompaundStatement:=CompaundStatement as TCompaundStatementAST;
          end;
      if  FuncImpAST.FuncDecl.Attr.Imp=faAssemble then
          begin
          LocalDecl:=DeclSectionParser.Parse(TS('asm'));
          FuncImpAST.LocalDec:=LocalDecl;
          ParseAsm(NAsmBlock);
          FuncImpAST.AsmBlock:=NAsmBlock as TForeignAsmAST;
          end;
      NeedSimvol(TS(';'));
    ASTFabric.LevalUp;
  Node:=FuncImpAST;

end;

procedure TImplemtSectionParser.ImplProcedure(var Node: TNodeAST);
var
  NHeading:TNodeAST;
  FuncImpAST:TFuncImpAST;
  LocalDecl:TDeclarationAST;
  CompaundStatement:TNodeAST;
  NAsmBlock:TNodeAST;
begin
  FuncImpAST:=ASTFabric.FuncImpCreate;
    ASTFabric.ActivLeaf:=FuncImpAST;
      DeclSectionParser.ProcedureHeading(NHeading);
      DeclSectionParser.ResultExist:=False;
      DeclSectionParser.ResultType:=Nil;
  FuncImpAST.FuncDecl:=NHeading as TFuncDeclAST;
      if  FuncImpAST.FuncDecl.Attr.Imp=faHoha then
          begin
          LocalDecl:=DeclSectionParser.Parse(TS('Begin'));
          FuncImpAST.LocalDec:=LocalDecl;
          StatementParser.ParseCompaundStatement(CompaundStatement);
          FuncImpAST.CompaundStatement:=CompaundStatement as TCompaundStatementAST;
          end;
      if  FuncImpAST.FuncDecl.Attr.Imp=faAssemble then
          begin
          LocalDecl:=DeclSectionParser.Parse(TS('asm'));
          FuncImpAST.LocalDec:=LocalDecl;
          ParseAsm(NAsmBlock);
          FuncImpAST.AsmBlock:=NAsmBlock as TForeignAsmAST;
          end;
      NeedSimvol(TS(';'));
    ASTFabric.LevalUp;
  Node:=FuncImpAST;
end;

function TImplemtSectionParser.IsNop(var Proc): Boolean;
var Ptr:Pointer;
  Proc2:TParserProcedure;
begin
  Ptr:=Pointer(Proc);
  Proc2:=Nop;
  Result:= (Ptr=@Proc2);
end;

procedure TImplemtSectionParser.MainBlock(var Node: TNodeAST);
begin
  StatementParser.ParseCompaundStatement(Node);
  //NeedSimvol(TS('.'));
end;
{var
  CompaundStatement:TNodeAST;
  MainBlockAST:TMainBlockAST;
begin
  MainBlockAST:=TMainBlockAST.Create;

    StatementParser.ParseCompaundStatement(CompaundStatement);
    NeedSimvol(TS('.'));

  MainBlockAST.CompaundStatement:=CompaundStatement;
  Node:=MainBlockAST;
end;  }

procedure TImplemtSectionParser.NOP(var Node: TNodeAST);
begin
// нечиго не делаем
end;

function TImplemtSectionParser.Parse(Anchor: TSimvol): TImplimentaionAST;
// Машина конечного числа состояний
const
  CommandCount=5;
var
  Prog:array [0..CommandCount-1] of TCaseCommand;
  procedure Init;
  begin
    Prog[0].Value:='function'; Prog[0].Woker:=ImplFunction;
    Prog[1].Value:='procedure'; Prog[1].Woker:=ImplProcedure;
    Prog[2].Value:='Begin'; Prog[2].Woker:=MainBlock;
    Prog[3].Value:='End';   Prog[3].Woker:=Nop;
    Prog[4].Value:='asm';   Prog[4].Woker:=AsmBlock;
  end;
var
  Woker:TParserProcedure;
  NodeAST:TNodeAST;
begin
Init;
Self.Anchor:=Anchor;

Result:=ASTFabric.ImplimentaionCreate;
ASTFabric.ActivLeaf:=Result;
NeedSimvol(TS('Implementation'));
  repeat
    NodeAST:=Nil;
    Woker:=ChooseOfWork(CommandCount,@Prog, CurrentSimvol());

    if @Woker=nil then
       begin
       Compiler.Error.Add(114, CurrentSimvol().Value);
       ErrorWay(Anchor);
       end else
       if Not IsNop(Woker) then
          begin
          Woker(NodeAST);
          Result.Add(NodeAST);
          end;

  until  (IsAnyAnchor) or (IsNop(Woker));
  if  Result.MainBlock=nil then
      NeedSimvol(TS('end'));
  ASTFabric.LevalUp;
  //  if (Result.ListFunc=Nil) and (Result.MainBlock=nil) then
//      FreeAndNil(Result);
end;

procedure TImplemtSectionParser.ParseAsm(var Node: TNodeAST);
begin
  Node:=ForeignAsmParser.Parse;
end;

procedure TImplemtSectionParser.AsmBlock(var Node: TNodeAST);
begin
  ParseAsm(Node);
  NeedSimvol(TS(';'));
end;

end.

Harold Lawson is credited with the 1964 invention of the pointer.[2] In 2000, Lawson was presented the Computer Pioneer Award by the IEEE “[f]or inventing the pointer variable and introducing this concept into PL/I, thus providing for the first time, the capability to flexibly treat linked lists in a general-purpose high level language”.[3] His seminal paper on the concepts appeared in the June, 1967 issue of CACM entitled: PL/I List Processing. According to the Oxford English Dictionary, the word pointer first appeared in print as a stack pointer in a technical memorandum by the System Development Corporation.

Например

У лиса нет высокооплачиваемой работы, когда он вроде писал, что работает в одном из крупнейших агрегаторов в рунете и что такие рыжие стоят 200+т.р/месяц.

И вообще - почему Лису?

Но без них невозможно на низком уровне.

Вы кого-то конкретного предлагаете? Тут на форуме нет никого.

Эта задача - не экономическая.

Вы хотите