Permalink
Browse files

implemented case statements

implemented for loop
its now properly possible to use vars in assembler blocks, now including locals and parameters
  • Loading branch information...
Memnarch committed Apr 15, 2012
1 parent 8c87450 commit b11963b2c26cbb513ce947a11890a2327ff29ee5
Showing with 359 additions and 20 deletions.
  1. +131 −0 CaseState.pas
  2. +140 −9 Compiler.pas
  3. +2 −1 CompilerProj.dpr
  4. +1 −0 CompilerProj.dproj
  5. +19 −1 DemoSource/Demo.pas
  6. +1 −1 Factor.pas
  7. +1 −1 Lexer/Lexer.pas
  8. +54 −1 Loops.pas
  9. +1 −1 Main.pas
  10. +1 −1 Optimizer.pas
  11. +2 −2 ProcDeclaration.pas
  12. +6 −2 VarDeclaration.pas
View
@@ -0,0 +1,131 @@
+unit CaseState;
+
+interface
+
+uses
+ Classes, Types, Generics.Collections, CodeElement;
+
+type
+ TCaseStatement = class(TCodeElement)
+ private
+ FCases: TObjectList<TCodeElement>;
+ FRelation: TObjectList<TCodeElement>;
+ FElseCase: TObjectList<TCodeElement>;
+ FId: string;
+ function GetJumpTable(): string;
+ public
+ constructor Create(); reintroduce;
+ destructor Destroy(); override;
+ function GetDCPUSource(): string; override;
+ property Relation: TObjectList<TCodeElement> read FRelation;
+ property Cases: TObjectList<TCodeElement> read FCases;
+ property ElseCase: TObjectList<TCodeElement> read FElseCase;
+ end;
+
+ TCase = class(TCodeElement)
+ private
+ FConstValues: TObjectList<TCodeElement>;
+ public
+ constructor Create(); reintroduce;
+ destructor Destroy(); override;
+ property ConstValues: TObjectList<TCodeElement> read FConstValues;
+ end;
+
+implementation
+
+uses
+ SysUtils, Factor, Optimizer;
+
+{ TCaseStatement }
+
+constructor TCaseStatement.Create;
+begin
+ inherited Create('');
+ FRelation := TObjectList<TCodeElement>.Create();
+ FCases := TObjectList<TCodeElement>.Create();
+ FElseCase := TObjectList<TCodeElement>.Create();
+ FId := GetUniqueID();
+end;
+
+destructor TCaseStatement.Destroy;
+begin
+ FRelation.Free;
+ FCases.Free;
+ FElseCase.Free;
+ inherited;
+end;
+
+function TCaseStatement.GetDCPUSource: string;
+var
+ LLabel: string;
+ LCase: TCase;
+ i: Integer;
+begin
+ Result := OptimizeDCPUCode(Relation.Items[0].GetDCPUSource());
+ Result := Result + 'set x, pop' + sLineBreak;
+ Result := Result + GetJumpTable();
+ for i := 0 to Cases.Count - 1 do
+ begin
+ Result := Result + ':case' + IntToStr(i) + FId + sLineBreak;
+ Result := Result + Cases.Items[i].GetDCPUSource();
+ Result := Result + 'set pc, ' + 'end' + FId + sLineBreak;
+ end;
+ if ElseCase.Count > 0 then
+ begin
+ Result := Result + ':else' + FId + sLineBreak;
+ Result := Result + ElseCase.Items[0].GetDCPUSource();
+ end;
+ Result := Result + ':end' + FId + sLineBreak;
+end;
+
+function TCaseStatement.GetJumpTable: string;
+var
+ LCase: TCase;
+ LFactor: TFactor;
+ i, k: Integer;
+ LJumpLabel: string;
+begin
+ Result := '';
+ for i := 0 to FCases.Count - 1 do
+ begin
+ LJumpLabel := 'case' + IntToStr(i) + FId;
+ LCase := TCase(FCases.Items[i]);
+ for k := 0 to LCase.ConstValues.Count - 1 do
+ begin
+ LFactor := TFactor(LCase.ConstValues.Items[k]);
+ if LFactor.IsConstant then
+ begin
+ Result := Result + 'ife x, ' + LFactor.Value + sLineBreak;
+ end
+ else
+ begin
+ Result := Result + 'ife x, ' + LFactor.VarDeclaration.DefaultValue + sLineBreak;
+ end;
+ Result := Result + 'set pc, ' + LJumpLabel + sLineBreak;
+ end;
+ end;
+ if ElseCase.Count > 0 then
+ begin
+ Result := Result + 'set pc, ' + 'else' + FId + sLineBreak;
+ end
+ else
+ begin
+ Result := Result + 'set pc, ' + 'end' + FId + sLineBreak;
+ end;
+end;
+
+{ TCase }
+
+constructor TCase.Create;
+begin
+ inherited Create('');
+ FConstValues := TObjectList<TCodeElement>.Create();
+end;
+
+destructor TCase.Destroy;
+begin
+ FConstValues.Free;
+ inherited;
+end;
+
+end.
View
@@ -40,17 +40,20 @@ TCompiler = class(TInterfacedObject, IOperations)
procedure ParseTypeDeclaration(AScope: TObjectList<TCodeElement>);
procedure ParseVars(AScope: TObjectList<TCodeElement>);
procedure ParseVarDeclaration(AScope: TObjectList<TCodeElement>; AIncludeEndMark: Boolean = True;
- AAsParameter: Boolean = False; AAsLocal: Boolean = False);
+ AAsParameter: Boolean = False; AAsLocal: Boolean = False; AAsConst: Boolean = False);
procedure ParseConsts(AScope: TObjectList<TCodeElement>);
procedure ParseRoutineDeclaration(AScope: TObjectList<TCodeElement>);
procedure ParseRoutineParameters(AScope: TObjectList<TCodeElement>);
procedure ParseRoutineLocals(AProc: TProcDeclaration);
procedure ParseRoutineContent(AScope: TObjectList<TCodeElement>);
function ParseRoutineCall(AScope: TObjectList<TCodeElement>; AIncludeEndMark: Boolean = True): TDataType;
- function ParseAssignment(AScope: TObjectList<TCodeElement>): TDataType;
+ function ParseAssignment(AScope: TObjectList<TCodeElement>; AIncludeEndmark: Boolean = True): TDataType;
procedure ParseCondition(AScope: TObjectList<TCodeElement>);
procedure ParseWhileLoop(AScope: TObjectList<TCodeElement>);
procedure ParseRepeatLoop(AScope: TObjectList<TCodeElement>);
+ procedure ParseForLoop(AScope: TObjectList<TCodeElement>);
+ procedure ParseCaseStatement(AScope: TObjectList<TCodeElement>);
+ procedure ParseCase(AScope: TObjectList<TCodeElement>);
function ParseRelation(AScope: TObjectList<TCodeElement>; ATryInverse: Boolean = False): TDataType;
function ParseExpression(AScope: TObjectList<TCodeElement>): TDataType;
function ParseTerm(AScope: TObjectList<TCodeElement>): TDataType;
@@ -84,7 +87,7 @@ TCompiler = class(TInterfacedObject, IOperations)
implementation
uses
- StrUtils, Relation, Expression, Term, Assignment, Condition, Loops, ProcCall, Optimizer;
+ StrUtils, Relation, Expression, Term, Assignment, Condition, Loops, ProcCall, CaseState, Optimizer;
{ TCompiler }
@@ -174,6 +177,7 @@ procedure TCompiler.CompileUnit;
constructor TCompiler.Create;
begin
+ inherited;
FUnits := TObjectList<TPascalUnit>.Create();
FOperations := TObjectList<TOperation>.Create();
FSearchPath := TStringList.Create();
@@ -335,14 +339,30 @@ procedure TCompiler.ParseASMBlock(AScope: TObjectList<TCodeElement>);
var
LToken: TToken;
LBlock: TASMBlock;
+ LContent: string;
+ LVar: TVarDeclaration;
begin
LBlock := TASMBlock.Create('');
AScope.Add(LBlock);
FLexer.GetToken('asm');
while not (FLexer.PeekToken.IsContent('end') and FLexer.AHeadToken.IsContent(';')) do
begin
LToken := FLexer.GetToken();
- LBlock.Source := LBlock.Source + LToken.Content;
+ LContent := LToken.Content;
+ if LToken.IsType(ttIdentifier) and (AnsiIndexText(LContent, ['a', 'b', 'c', 'x', 'y', 'z', 'i', 'j']) < 0) then
+ begin
+ LVar := TVarDeclaration(GetElement(LContent, TVarDeclaration));
+ if Assigned(LVar) then
+ begin
+ LContent := LVar.GetAccessIdentifier();
+ if ((LVar.ParamIndex < 1) or (LVar.ParamIndex > 3)) and (LVar.IsParameter or LVar.IsLocal)
+ and (not FLexer.PeekToken.IsContent(']')) then
+ begin
+ LContent := '[' + LContent + ']';
+ end;
+ end;
+ end;
+ LBlock.Source := LBlock.Source + LContent;
if (LToken.IsType(ttIdentifier) or LToken.IsType(ttReserved)
or (AnsiIndexText(LToken.Content, ['and', 'or', 'mod']) >= 0))
and (not (FLexer.PeekToken.IsContent(']') or FLexer.PeekToken.IsType(ttTermOp))) then
@@ -358,7 +378,7 @@ procedure TCompiler.ParseASMBlock(AScope: TObjectList<TCodeElement>);
FLexer.GetToken(';');
end;
-function TCompiler.ParseAssignment(AScope: TObjectList<TCodeElement>): TDataType;
+function TCompiler.ParseAssignment(AScope: TObjectList<TCodeElement>; AIncludeEndmark: Boolean = True): TDataType;
var
LAssignment: TAssignment;
LRelType: TDataType;
@@ -372,6 +392,10 @@ function TCompiler.ParseAssignment(AScope: TObjectList<TCodeElement>): TDataType
FLexer.GetToken('(');
end;
LAssignment.TargetVar := GetVar(FLexer.GetToken('', ttIdentifier).Content);
+ if LAssignment.TargetVar.IsConst then
+ begin
+ Fatal('Cannot assign to a const value');
+ end;
AScope.Add(LAssignment);
if FLexer.PeekToken.IsContent('^') then
begin
@@ -390,13 +414,82 @@ function TCompiler.ParseAssignment(AScope: TObjectList<TCodeElement>): TDataType
end;
FLexer.GetToken(':=');
LRelType := ParseRelation(LAssignment.SubElements);
- FLexer.GetToken(';');
+ if AIncludeEndmark then
+ begin
+ FLexer.GetToken(';');
+ end;
if LRelType.RawType <> Result.RawType then
begin
Fatal('Cannot assign ' + QuotedStr(LRelType.Name) + ' to ' + QuotedStr(Result.Name));
end;
end;
+procedure TCompiler.ParseCase(AScope: TObjectList<TCodeElement>);
+var
+ LCase: TCase;
+ LFactor: TFactor;
+ LRepeat: Boolean;
+begin
+ LCase := TCase.Create();
+ AScope.Add(LCase);
+ LRepeat := False;
+ while (not FLexer.PeekToken.IsContent(':')) or LRepeat do
+ begin
+ LRepeat := False;
+ if ParseFactor(LCase.ConstValues).RawType <> rtUInteger then
+ begin
+ Fatal('value must be of type unsigned Integer');
+ end;
+ LFactor := TFactor(LCase.ConstValues.Items[LCase.ConstValues.Count-1]);
+ if (not LFactor.IsConstant) and ((Assigned(LFactor.VarDeclaration) and (not LFactor.VarDeclaration.IsConst))) then
+ begin
+ Fatal('Value must be of type const');
+ end;
+ if (LFactor.SubElements.Count > 0) or LFactor.Inverse or LFactor.GetAdress or LFactor.Dereference then
+ begin
+ Fatal('illegal statement');
+ end;
+ if FLexer.PeekToken.IsContent(',') then
+ begin
+ FLexer.GetToken(',');
+ LRepeat := True;
+ end;
+ end;
+ FLexer.GetToken(':');
+ FLexer.GetToken('begin');
+ ParseRoutineContent(LCase.SubElements);
+ FLexer.GetToken('end');
+ FLexer.GetToken(';');
+end;
+
+procedure TCompiler.ParseCaseStatement(AScope: TObjectList<TCodeElement>);
+var
+ LStatement: TCaseStatement;
+begin
+ FLexer.GetToken('case');
+ LStatement := TCaseStatement.Create();
+ AScope.Add(LStatement);
+ if ParseRelation(LStatement.Relation).RawType <> rtUInteger then
+ begin
+ Fatal('Relation of Case requires returntype of unsigned integer');
+ end;
+ FLexer.GetToken('of');
+ while (not FLexer.PeekToken.IsContent('end')) and (not FLexer.PeekToken.IsContent('else')) do
+ begin
+ ParseCase(LStatement.Cases);
+ end;
+ if FLexer.PeekToken.IsContent('else') then
+ begin
+ FLexer.GetToken('else');
+ FLexer.GetToken('begin');
+ ParseRoutineContent(LStatement.ElseCase);
+ FLexer.GetToken('end');
+ FLexer.GetToken(';');
+ end;
+ FLexer.GetToken('end');
+ FLexer.GetToken(';');
+end;
+
procedure TCompiler.ParseCondition(AScope: TObjectList<TCodeElement>);
var
LCondition: TCondition;
@@ -445,7 +538,11 @@ function TCompiler.ParseConstantFactor(AFactor: TFactor): TDataType;
procedure TCompiler.ParseConsts;
begin
-
+ FLexer.GetToken('const');
+ while not FLexer.PeekToken.IsType(ttReserved) do
+ begin
+ ParseVarDeclaration(AScope, True, False, False, True);
+ end;
end;
function TCompiler.ParseExpression(AScope: TObjectList<TCodeElement>): TDataType;
@@ -565,6 +662,29 @@ function TCompiler.ParseFactor(AScope: TObjectList<TCodeElement>): TDataType;
end;
end;
+procedure TCompiler.ParseForLoop(AScope: TObjectList<TCodeElement>);
+var
+ LFor: TForLoop;
+begin
+ LFor := TForLoop.Create();
+ AScope.Add(LFor);
+ FLexer.GetToken('for');
+ if ParseAssignment(LFor.Assignment, False).RawType <> rtUInteger then
+ begin
+ Fatal('assignment must be of type unsigned integer');
+ end;
+ FLexer.GetToken('to');
+ if ParseRelation(LFor.Relation).RawType <> rtUInteger then
+ begin
+ Fatal('Result of relation must be of type unsigned integer');
+ end;
+ FLexer.GetToken('do');
+ FLexer.GetToken('begin');
+ ParseRoutineContent(LFor.SubElements);
+ FLexer.GetToken('end');
+ FLexer.GetToken(';');
+end;
+
function TCompiler.ParseRelation(AScope: TObjectList<TCodeElement>; ATryInverse: Boolean = False): TDataType;
var
LRelation: TRelation;
@@ -652,7 +772,7 @@ procedure TCompiler.ParseRoutineContent(AScope: TObjectList<TCodeElement>);
case FLexer.PeekToken.TokenType of
ttIdentifier, ttReserved:
begin
- case AnsiIndexText(FLexer.PeekToken.Content, ['if', 'while', 'repeat', 'asm']) of
+ case AnsiIndexText(FLexer.PeekToken.Content, ['if', 'while', 'repeat', 'asm', 'for', 'case']) of
0:
begin
ParseCondition(AScope);
@@ -668,6 +788,16 @@ procedure TCompiler.ParseRoutineContent(AScope: TObjectList<TCodeElement>);
3:
begin
ParseASMBlock(AScope);
+ end;
+
+ 4:
+ begin
+ ParseForLoop(AScope);
+ end;
+
+ 5:
+ begin
+ ParseCaseStatement(AScope);
end
else
@@ -889,7 +1019,7 @@ procedure TCompiler.ParseVarDeclaration;
end;
FLexer.GetToken(':');
LType := GetDataType(FLexer.GetToken('', ttIdentifier).Content);
- if AIncludeEndMark and (not (AAsParameter or AAsLocal)) and (FLexer.PeekToken.IsContent('=')) then
+ if AIncludeEndMark and (not (AAsParameter or AAsLocal)) and (FLexer.PeekToken.IsContent('=') or AAsConst) then
begin
FLexer.GetToken();
if LType.RawType = rtString then
@@ -916,6 +1046,7 @@ procedure TCompiler.ParseVarDeclaration;
for LName in LNames do
begin
LVarDec := TVarDeclaration.Create(LName, LType);
+ LVarDec.IsConst := AAsConst;
LVarDec.DefaultValue := LDef;
if AAsParameter or AAsLocal then
begin
Oops, something went wrong.

0 comments on commit b11963b

Please sign in to comment.