Курсовая работа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.