Курсовая работа1 / Parser / UCcSymbols

{
  C-like language compiler v0.1.0.485

  12 november 2007

  Copyright (C) 2006, 2007 Igor Krooshch
  rheo.ikro@gmail.com

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
  License as published by the Free Software Foundation; either
  version 2.1 of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  Lesser General Public License for more details.

  You should have received a copy of the GNU Lesser General Public
  License along with this library; if not, write to the Free Software
  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
}

unit UCcSymbols;

interface

uses
  SysUtils, Classes, IniFiles,
  UCcSyntaxEntries, UCcCodeGenerator, UCcCodeGeneratorCommands, UCcBuffer;

type
  TCcSymType = class;

  TCcSymbolClass = class of TCcSymbol;
  TCcSymbol = class(TCcSyntaxObject)
  private
    FName: string;
    FIsFake: boolean;
    FGenerated: boolean;
    procedure SetGenerated(const AValue: boolean);
    procedure SetName(const AName: string);
    procedure SetIsFake(const AValue: boolean);
  public
    constructor Create(APosition: TCcPosition); reintroduce;

    function Size: integer; virtual;

    property IsFake: boolean read FIsFake write SetIsFake;
    property Generated: boolean read FGenerated write SetGenerated;
    property Name: string read FName write SetName;
  end;


  TCcSymTable = class
  private
    FSize: integer;
    FList: THashedStringList;
    FParent: TCcSymTable;

    FSkipGenList: TStringList;

    FGenerated: boolean;

    FTokenizer: TObject;   //  for raising exceptions only
    FIsParams: boolean;
    FOffset: integer;

    FRealSize: integer;
    FRealCount: integer;

    function GetSymbol(AIndex: integer): TCcSymbol;
  public
    constructor Create(
      APosition: TCcPosition; AParent: TCcSymTable; ATokenizer: TObject;
      const AIsParams: boolean = false);
    destructor Destroy; override;

    function Find(
      const APosition: TCcPosition;
      const AName: string;
      const ASymClass: TCcSymbolClass;
      const AGlobal: boolean = true;
      const AShowError: boolean = true): TCcSymbol;
    procedure Add(ASymbol: TCcSymbol; const AFake: boolean = false);

    procedure AddSkipGenFunc(const AName: string);

    function RealCount: integer;
    function RealSize: integer;
    function Count: integer;
    function Size: integer;

    procedure Generate(AGenerator: TObject);

    property Generated: boolean read FGenerated write FGenerated;
    property Offset: integer read FOffset;
    property IsParams: boolean read FIsParams;
    property Parent: TCcSymTable read FParent;
    property Symbol[AIndex: integer]: TCcSymbol read GetSymbol; default;
  end;


  PCcSymTableStackRec = type Pointer;

  TCcSymTableStack = class
  private
    FStack: TList;

    FTopTable: TCcSymTable;
  public
    constructor Create(APosition: TCcPosition);
    destructor Destroy; override;

    procedure Push(ATable: TCcSymTable);
    function Pop: TCcSymTable;

    function SaveState: PCcSymTableStackRec;
    procedure LoadState(AState: PCcSymTableStackRec);

    function TopTable: TCcSymTable;
  end;


  TCcSymVariable = class(TCcSymbol)
  private
    FValType: TCcSymType;
    FValue: TCcExpression;
    FOffset: integer;
    FTable: TCcSymTable;
  public
    constructor Create(
      APosition: TCcPosition; const AName: string; AVal: TCcSymType;
      AValue: TCcExpression = nil; ATable: TCcSymTable = nil);
    property ValType: TCcSymType read FValType;
    property Value: TCcExpression read FValue;

    function Offset: integer;
    function Size: integer; override;
    function Table: TCcSymTable;

    function GenerateLine: string;
  end;


  TCcSymTypeClass = class of TCcSymType;

  TCcSymType = class(TCcSymbol)
  public
    function IsType(ATypeClass: TCcSymTypeClass): boolean; virtual;
    function GetType: TCcSymType; virtual;

    function GenerateTypeStr: string; virtual; abstract;
  end;

  TCcSymTypeScalar = class(TCcSymType);


  TCcSymTypePointer = class(TCcSymType)
  private
    FPtrType: TCcSymType;
  public
    function GenerateTypeStr: string; override;

    constructor Create(APosition: TCcPosition; AValType: TCcSymType);
    function Size: Integer; override;

    property PtrType: TCcSymType read FPtrType;
  end;


  TCcSymTypeStr = class(TCcSymTypeScalar)
  public
    function GenerateTypeStr: string; override;
  end;
  

  TCcSymTypeInt = class(TCcSymTypeScalar)
  public
    function Size: Integer; override;

    function GenerateTypeStr: string; override;
  end;


  TCcSymTypeFloat = class(TCcSymTypeScalar)
  public
    function Size: Integer; override;
    function GenerateTypeStr: string; override;
  end;


  TCcSymTypeVoid = class(TCcSymType)
  public
    function GenerateTypeStr: string; override;
  end;


  TCcSymAlias = class(TCcSymType)
  private
    FSrcType: TCcSymType;
  public
    constructor Create(ASrcType: TCcSymType; APosition: TCcPosition); reintroduce;

    function IsType(ATypeClass: TCcSymTypeClass): Boolean; override;
    function GetType: TCcSymType; override;

    function Size: Integer; override;

    function GenerateTypeStr: string; override;

    property SrcType: TCcSymType read FSrcType;
  end;


  TCcSymArray = class(TCcSymType)
  private
    FLength: integer;
    FValType: TCcSymType;
    FDimension: integer;
    FDimSize: integer;

    FMaxDim: integer;
  public
    constructor Create(
      APosition: TCcPosition; AValType: TCcSymType; ALength: integer);

    function Size: integer; override;

    function DimensionSize(ADim: integer): integer;

    function GenerateTypeStr: string; override;

    property Dimension: integer read FDimension write FDimension;
    property Length: integer read FLength;
    property ValType: TCcSymType read FValType;

    property MaxDim: integer read FMaxDim;
  end;


  TCcSymStruct = class(TCcSymType)
  private
    FFields: TCcSymTable;
  public
    constructor Create(APosition: TCcPosition; AFields: TCcSymTable);
    destructor Destroy; override;

    function GenerateTypeStr: string; override;
    function Size: Integer; override;

    property Fields: TCcSymTable read FFields;
  end;


  TCcSymProc = class(TCcSymbol)
  private
    FTable: TCcSymTable;
    FParams: TCcSymTable;
    FBlock: TCcBlockStatement;
  public
    constructor Create(
      APosition: TCcPosition; AParentTable: TCcSymTable;
      ATokenizer: TObject); virtual;
    destructor Destroy; override;

    procedure Generate(AGenerator: TCcCodeGenerator); override;

    procedure AddParam(AVar: TCcSymVariable; const AFake: boolean = false);
    procedure SetBlock(ABlock: TCcBlockStatement);

    property Block: TCcBlockStatement read FBlock;

    property Params: TCcSymTable read FParams;
    property Table: TCcSymTable read FTable;
  end;


  TCcSymFunc = class(TCcSymProc)
  private
    FReturn: TCcSymType;
  public
    constructor Create(
      APosition: TCcPosition; AParentTable: TCcSymTable;
      ATokenizer: TObject); override;

    procedure SetReturn(AReturn: TCcSymType);

    property Return: TCcSymType read FReturn;
  end;

var
  SymInt: TCcSymTypeInt = nil;
  SymFloat: TCcSymTypeFloat = nil;
  SymVoid: TCcSymTypeVoid = nil;
  SymStr: TCcSymTypeStr = nil;

implementation

uses
  UCcTokenizer, 
  UCcParserConsts, UCcSymanticConsts;


const
  POINTER_SIZE = 4;
  FUNC_STACK_OFFSET = 8;


{ TCcSymTable }

procedure TCcSymTable.Add(ASymbol: TCcSymbol; const AFake: boolean);
var
  s: TCcSymbol;
begin
  s := Find(ASymbol.Position, ASymbol.Name, nil, false, false);
  if (s <> nil) then
    (FTokenizer as TCcTokenizer).ErrorFmt(
      SCcParserRedefinitionFmt, [ASymbol.Name]);
  if (ASymbol is TCcSymVariable) then begin
    TCcSymVariable(ASymbol).FOffset := FSize;
    Inc(FSize, TCcSymVariable(ASymbol).Size);
    if TCcSymVariable(ASymbol).ValType.IsType(TCcSymTypePointer) then
      Inc(FRealSize, 4)
    else
      Inc(FRealSize, TCcSymVariable(ASymbol).Size);
  end;

  FList.AddObject(ASymbol.Name, ASymbol);
  if not AFake then
    Inc(FRealCount)
  else
    ASymbol.IsFake := true;
end;


procedure TCcSymTable.AddSkipGenFunc(const AName: string);
begin
  FSkipGenList.Add(AName);
end;


function TCcSymTable.Count: integer;
begin
  Result := FList.Count;
end;


constructor TCcSymTable.Create(
  APosition: TCcPosition; AParent: TCcSymTable; ATokenizer: TObject;
  const AIsParams: boolean);
begin
  inherited Create;
  FRealSize := 0;
  FRealCount := 0;
  FGenerated := false;
  FSkipGenList := TStringList.Create;
  FSkipGenList.Sorted := true;
  FParent := AParent;
  FTokenizer := ATokenizer;
  FList := THashedStringList.Create;
  FList.CaseSensitive := true;
  FIsParams := AIsParams;
  FOffset := 0;
  if
    (not IsParams) and (AParent <> nil) and
    (not AParent.IsParams) and (AParent.Parent <> nil)
  then
    FOffset := AParent.Size + AParent.Offset
  else if IsParams then
    FOffset := FUNC_STACK_OFFSET;
end;


destructor TCcSymTable.Destroy;
var
  i: integer;
begin
  for i := 0 to FList.Count - 1 do
    TObject(FList.Objects[i]).Free;
  FList.Free;
  FSkipGenList.Free;
  inherited;
end;


function TCcSymTable.Find(
  const APosition: TCcPosition; const AName: string;
  const ASymClass: TCcSymbolClass; const AGlobal: boolean;
  const AShowError: boolean): TCcSymbol;
var
  i: integer;
begin
  Result := nil;
  i := FList.IndexOf(AName);
  if (i > -1) then begin
    Result := TCcSymbol(FList.Objects[i]);
    if (ASymClass <> nil) and not (Result is ASymClass) then
      if AShowError then
        SymanticError(APosition, SCcSymanticIncompatibleTypes)
      else begin
        Result := nil;
        Exit;
      end;
  end
  else
    if AGlobal and (Parent <> nil) then
      Result := Parent.Find(APosition, AName, ASymClass, true, AShowError);
  if (Result = nil) and AShowError then
    SymanticError(APosition, SCcSymanticUndefinedType);
end;


procedure TCcSymTable.Generate(AGenerator: TObject);
var
  gen: TCcCodeGenerator;
  i: integer;
  symVar: TCcSymVariable;
  sym: TCcSymbol;
  ofs: integer;
begin
  gen := AGenerator as TCcCodeGenerator;
  if Parent = nil then begin
    for i := 0 to FList.Count - 1 do begin
      sym := TCcSymbol(FList.Objects[i]);
      if not sym.Generated then begin
        if (sym is TCcSymVariable) then
          gen.Gen(TCcSymVariable(sym).GenerateLine, Parent = nil)
        else if (sym is TCcSymFunc) then
          if FSkipGenList.IndexOf(TCcSymFunc(sym).Name) = -1 then
            TCcSymFunc(sym).Generate(gen);
        sym.Generated := true;
      end;
    end;
  end
  else if not IsParams then begin
    if not Generated then begin
      (AGenerator as TCcCodeGenerator).Gen(ctSub, 'esp', IntToStr(Size));
      Generated := true;
    end;
    for i := 0 to FList.Count - 1 do begin
      sym := TCcSymbol(FList.Objects[i]);
      if not sym.Generated then begin
        sym.Generated := true;
        if FList.Objects[i] is TCcSymVariable then begin
          symVar := TCcSymVariable(FList.Objects[i]);
          ofs := Offset + symVar.Offset + symVar.Size;
          if symVar.Value is TCcSyntaxConstInteger then begin
            gen.Gen(ctMov, 'eax', 'ebp');
            gen.Gen(ctSub, 'eax', IntToStr(ofs));
            gen.Gen(
              ctMov, '[eax]',
              'dword ptr ' +
                IntToStr(TCcSyntaxConstInteger(symVar.Value).Value));
          end
          else if symVar.Value is TCcSyntaxConstFloat then begin
            gen.Gen(ctMov, 'eax', 'ebp');
            gen.Gen(ctSub, 'eax', IntToStr(ofs));
            symVar.Value.Generate(gen);
            gen.Gen(ctPop, 'ebx');
            gen.Gen(ctMov, '[eax]', 'ebx');
          end;
        end;
      end;
    end;
  end;
end;


function TCcSymTable.GetSymbol(AIndex: integer): TCcSymbol;
var
  i, ci: integer;
  sym: TCcSymbol;
begin
  if (AIndex < 0) or (AIndex > RealCount - 1) then
    SymanticError(
      TCcTokenizer(FTokenizer).Position, SCcSymanticIndexOutOfBounds);
  Result := nil;
  ci := 0;
  for i := 0 to FList.Count - 1 do begin
    sym := FList.Objects[i] as TCcSymbol;
    if sym.IsFake then
      Continue;
    if (AIndex = ci) then begin
      Result := sym;
      Exit;
    end
    else
      Inc(ci);
  end;
end;


function TCcSymTable.RealCount: integer;
begin
  Result := FRealCount;
end;


function TCcSymTable.RealSize: integer;
begin
  Result := FRealSize;
end;


function TCcSymTable.Size: integer;
begin
  Result := FSize;
end;


{ TCcSymTableStack }

constructor TCcSymTableStack.Create(APosition: TCcPosition);
begin
  FStack := TList.Create;
  FTopTable := nil;
end;


destructor TCcSymTableStack.Destroy;
begin
  while (FStack.Count > 0) do
    Pop;
  FStack.Free;
  inherited;
end;


procedure TCcSymTableStack.LoadState(AState: PCcSymTableStackRec);
begin
  if Integer(AState) > FStack.Count then
    SymanticErrorFmt(
      CcPosition(0, 0), SCcSymanticInternalErrorFmt, [SCcInternalTS01]);
  while (FStack.Count <> Integer(AState)) do
    Pop;
end;


function TCcSymTableStack.Pop: TCcSymTable;
begin
  if FStack.Count = 0 then
    SymanticError(CcPosition(0, 0), SCcSymanticTableStackEmpty);
  Result := FStack[FStack.Count - 1];
  FStack.Delete(FStack.Count - 1);
  if (FStack.Count = 0) then
    FTopTable := nil
  else
    FTopTable := FStack[FStack.Count - 1];
end;


procedure TCcSymTableStack.Push(ATable: TCcSymTable);
begin
  FStack.Add(ATable);
  FTopTable := ATable;
end;


function TCcSymTableStack.SaveState: PCcSymTableStackRec;
begin
  Result := PCcSymTableStackRec(FStack.Count);
end;


function TCcSymTableStack.TopTable: TCcSymTable;
begin
  Result := FTopTable;
end;


{ TCcSymArray }

constructor TCcSymArray.Create(
  APosition: TCcPosition; AValType: TCcSymType; ALength: integer);
begin
  inherited Create(APosition);
  FDimension := 0;
  FValType := AValType;
  if FValType.IsType(TCcSymArray) then
    FDimension := TCcSymArray(FValType.GetType).Dimension + 1;
  FLength := ALength;
  FDimSize := FValType.Size * Length;
  FMaxDim := FDimension;
end;


function TCcSymArray.DimensionSize(ADim: integer): integer;
var
  vt: TCcSymType;
  a: integer;
begin
  Result := 0;
  if (ADim > Dimension) then
    SymanticError(Position, SCcSymanticDimension);

  vt := ValType.GetType;
  if ValType.IsType(TCcSymTypeScalar) then begin
    if (ADim < 1) then
      Result := ValType.Size
    else
      SymanticErrorFmt(
        Position, SCcSymanticInternalErrorFmt, [SCcInternalDS01]);

    if ADim = 0 then
      Result := Result * Length;
  end
  else begin
    a := ADim;
    if (a = -1) then
      a := 0;
    while (TCcSymArray(vt).Dimension > a) do
      vt := TCcSymArray(vt).ValType.GetType;
    if (ADim > -1) then
      Result := TCcSymArray(vt).Size
    else
      Result := TCcSymArray(vt).ValType.Size;
  end;
end;


function TCcSymArray.GenerateTypeStr: string;
begin
  Result := Format('db %d dup (?)', [Size]);
end;


function TCcSymArray.Size: Integer;
begin
  if (FLength = -1) then
    Result := POINTER_SIZE
  else
    Result := Length * ValType.Size; 
end;


{ TCcSymVariable }

constructor TCcSymVariable.Create(
  APosition: TCcPosition; const AName: string; AVal: TCcSymType;
  AValue: TCcExpression; ATable: TCcSymTable);
begin
  FValType := AVal;
  FValue := AValue;
  FTable := ATable;
  SetName(AName);
end;


function TCcSymVariable.GenerateLine: string;
var
  s: string;
  i: ^LongWord;
  f: real;
begin
  if (Value <> nil) then begin
    if not (Value is TCcSyntaxConst) then
      SymanticError(Position, SCcSymanticInitialization);

    if (Value is TCcSyntaxConstInteger) then
      s := IntToStr((Value as TCcSyntaxConstInteger).Value)
    else begin
      f := (Value as TCcSyntaxConstFloat).Value;
      i := @f;
      s := Format('0%sh', [IntToHex(i^, 8)]);
    end;
  end
  else
    s := '?';

  if ValType.IsType(TCcSymArray) or ValType.IsType(TCcSymStruct) then
    Result := Format('%s %s', [FormatVarName(Name), ValType.GenerateTypeStr])
  else
    Result :=
      Format('%s %s %s', [FormatVarName(Name), ValType.GenerateTypeStr, s]);
end;


function TCcSymVariable.Offset: integer;
begin
  Result := FOffset;
end;


function TCcSymVariable.Size: Integer;
begin
  Result := ValType.Size;
end;


function TCcSymVariable.Table: TCcSymTable;
begin
  Result := FTable;
end;


{ TCcSymbol }

constructor TCcSymbol.Create(APosition: TCcPosition);
begin
  inherited Create(APosition);
  FIsFake := false;
  FGenerated := false;
end;


procedure TCcSymbol.SetGenerated(const AValue: boolean);
begin
  FGenerated := AValue;
end;


procedure TCcSymbol.SetIsFake(const AValue: boolean);
begin
  FIsFake := AValue;
end;


procedure TCcSymbol.SetName(const AName: string);
begin
  FName := AName;
end;


function TCcSymbol.Size: integer;
begin
  Result := 0;
end;


{ TCcSymProc }

procedure TCcSymProc.AddParam(AVar: TCcSymVariable; const AFake: boolean);
begin
  Params.Add(AVar, AFake);
end;


constructor TCcSymProc.Create(
  APosition: TCcPosition; AParentTable: TCcSymTable; ATokenizer: TObject);
begin
  FParams :=
    TCcSymTable.Create(
      APosition, AParentTable, ATokenizer as TCcTokenizer, true);
  FTable := TCcSymTable.Create(APosition, FParams, ATokenizer as TCcTokenizer);
end;


destructor TCcSymProc.Destroy;
begin
  FTable.Free;
  FParams.Free;
  inherited;
end;


procedure TCcSymProc.Generate(AGenerator: TCcCodeGenerator);
begin
  AGenerator.StartProc(Name, Table);
  Block.Generate(AGenerator);
  AGenerator.EndProc;
end;


procedure TCcSymProc.SetBlock(ABlock: TCcBlockStatement);
begin
  FBlock := ABlock;
end;


{ TCcSymTypeInt }

function TCcSymTypeInt.GenerateTypeStr: string;
begin
  Result := 'dd ';
end;


function TCcSymTypeInt.Size: Integer;
begin
  Result := 4;
end;


{ TCcSymTypeFloat }

function TCcSymTypeFloat.GenerateTypeStr: string;
begin
  Result := 'dd ';
end;


function TCcSymTypeFloat.Size: Integer;
begin
  Result := 4;
end;


{ TCcSymTypeVoid }

function TCcSymTypeVoid.GenerateTypeStr: string;
begin
  Result := '';
end;


{ TCcSymAlias }

constructor TCcSymAlias.Create(ASrcType: TCcSymType; APosition: TCcPosition);
begin
  inherited Create(APosition);
  FSrcType := ASrcType;
end;


function TCcSymAlias.GenerateTypeStr: string;
begin
  Result := SrcType.GenerateTypeStr;
end;


function TCcSymAlias.GetType: TCcSymType;
begin
  Result := SrcType;
end;


function TCcSymAlias.IsType(ATypeClass: TCcSymTypeClass): Boolean;
begin
  Result := SrcType.IsType(ATypeClass);
end;


function TCcSymAlias.Size: Integer;
begin
  Result := SrcType.Size;
end;


{ TCcSymStruct }

constructor TCcSymStruct.Create(APosition: TCcPosition; AFields: TCcSymTable);
begin
  FFields := AFields;
end;


destructor TCcSymStruct.Destroy;
begin
  FFields.Free;
  inherited;
end;


function TCcSymStruct.GenerateTypeStr: string;
begin
  Result := Format('db %d dup (?)', [Fields.Size]);
end;


function TCcSymStruct.Size: Integer;
begin
  Result := Fields.Size;
end;


{ TCcSymFunc }

constructor TCcSymFunc.Create(
  APosition: TCcPosition; AParentTable: TCcSymTable; ATokenizer: TObject);
begin
  inherited;
  FReturn := SymVoid;
end;


procedure TCcSymFunc.SetReturn(AReturn: TCcSymType);
begin
  FReturn := AReturn;
end;


{ TCcSymTypePointer }

constructor TCcSymTypePointer.Create(
  APosition: TCcPosition; AValType: TCcSymType);
begin
  FPtrType := AValType;
end;


function TCcSymTypePointer.GenerateTypeStr: string;
begin
  Result := '';
end;


function TCcSymTypePointer.Size: Integer;
begin
  Result := PtrType.Size;
end;


{ TCcSymTypeStr }

function TCcSymTypeStr.GenerateTypeStr: string;
begin
  Result := '';
end;


{ TCcSymType }

function TCcSymType.GetType: TCcSymType;
begin
  Result := Self;
end;


function TCcSymType.IsType(ATypeClass: TCcSymTypeClass): boolean;
begin
  Result := Self is ATypeClass;
end;


initialization
  SymInt := TCcSymTypeInt.Create(CcPosition(0, 0));
  SymInt.Name := 'int';

  SymFloat := TCcSymTypeFloat.Create(CcPosition(0, 0));
  SymFloat.Name := 'float';
  
  SymVoid := TCcSymTypeVoid.Create(CcPosition(0, 0));
  SymStr := TCcSymTypeStr.Create(CcPosition(0, 0));

finalization
  SymStr.Free;
  SymVoid.Free;
  SymFloat.Free;
  SymInt.Free;

end.