Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
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...
commit b11963b2c26cbb513ce947a11890a2327ff29ee5 1 parent 8c87450
@Memnarch authored
View
131 CaseState.pas
@@ -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
149 Compiler.pas
@@ -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,6 +339,8 @@ procedure TCompiler.ParseASMBlock(AScope: TObjectList<TCodeElement>);
var
LToken: TToken;
LBlock: TASMBlock;
+ LContent: string;
+ LVar: TVarDeclaration;
begin
LBlock := TASMBlock.Create('');
AScope.Add(LBlock);
@@ -342,7 +348,21 @@ procedure TCompiler.ParseASMBlock(AScope: TObjectList<TCodeElement>);
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
View
3  CompilerProj.dpr
@@ -25,7 +25,8 @@ uses
D16Assembler in 'D16Assembler.pas',
Operation in 'Operation.pas',
Operations in 'Operations.pas',
- HeaderMessage in 'HeaderMessage.pas';
+ HeaderMessage in 'HeaderMessage.pas',
+ CaseState in 'CaseState.pas';
{$R *.res}
View
1  CompilerProj.dproj
@@ -76,6 +76,7 @@
<DCCReference Include="Operation.pas"/>
<DCCReference Include="Operations.pas"/>
<DCCReference Include="HeaderMessage.pas"/>
+ <DCCReference Include="CaseState.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
View
20 DemoSource/Demo.pas
@@ -13,12 +13,30 @@
msgKey: string = 'Key Test:';
PTest: PTestArray = 0x8000;
LVar: Word = 5;
+ k, m: Word;
+
+const
+ IsFive: Word = 5;
begin
CLS(0);
PrintLn(msgKey);
PrintHex(0xF23c);
- PrintChar(PTest[1][2] and 0xFF);
+ case LVar + 1 of
+ 1, 2:
+ begin
+ println('its 1 or 2');
+ end;
+ IsFive:
+ begin
+ println('its 5');
+ end;
+
+ else
+ begin
+ println('its something else');
+ end;
+ end;
while not false do
begin
PrintChar(GetKey());
View
2  Factor.pas
@@ -181,7 +181,7 @@ function TFactor.GetPushValue: string;
function TFactor.IsConstant: Boolean;
begin
- Result := not Assigned(FVarDeclaration);
+ Result := (not Assigned(FVarDeclaration)) and (SubElements.Count = 0);
end;
end.
View
2  Lexer/Lexer.pas
@@ -280,7 +280,7 @@ procedure TLexer.ParseOperator;
procedure TLexer.ParseSource;
begin
FPos := 1;
- FLine := 0;
+ FLine := 1;
while FPos <= Length(FSource) do
begin
case GetChar of
View
55 Loops.pas
@@ -25,11 +25,21 @@ TRepeatLoop = class(TLoop)
function GetDCPUSource(): string; override;
end;
+ TForLoop = class(TLoop)
+ private
+ FAssignment: TObjectList<TCodeElement>;
+ public
+ constructor Create();
+ destructor Destroy(); override;
+ function GetDCPUSource(): string; override;
+ property Assignment: TObjectList<TCodeElement> read FAssignment;
+ end;
+
implementation
uses
- Optimizer;
+ Optimizer, Assignment;
{ TLoop }
@@ -86,4 +96,47 @@ function TRepeatLoop.GetDCPUSOurce: string;
Result := Result + OptimizeDCPUCode(LRelSource);
end;
+{ TForLoop }
+
+constructor TForLoop.Create;
+begin
+ inherited;
+ FAssignment := TObjectList<TCodeElement>.Create();
+end;
+
+destructor TForLoop.Destroy;
+begin
+ FAssignment.Free;
+ inherited;
+end;
+
+function TForLoop.GetDCPUSource: string;
+var
+ LID: string;
+ LFor: string;
+ LEnd: string;
+ LVar: string;
+begin
+ LID := GetUniqueID('');
+ LVar := TAssignment(Assignment.Items[0]).TargetVar.GetAccessIdentifier();
+ if (TAssignment(Assignment.Items[0]).TargetVar.ParamIndex > 3) or (TAssignment(Assignment.Items[0]).TargetVar.ParamIndex < 1) then
+ begin
+ LVar := '[' + LVar + ']';
+ end;
+ LFor := 'for' + LID;
+ LEnd := 'end' + LID;
+ Result := OptimizeDCPUCode(Assignment.Items[0].GetDCPUSource());
+ Result := Result + OptimizeDCPUCode(Relation.Items[0].GetDCPUSource());
+ Result := Result + ':' + LFor + sLineBreak;
+ Result := Result + 'set x, pop' + sLineBreak;
+ Result := Result + 'ifg ' + LVar +
+ ', x' + sLineBreak;
+ Result := Result + 'set pc, ' + LEnd + sLineBreak;
+ Result := Result + 'set push, x' + sLineBreak;
+ Result := Result + inherited;
+ Result := Result + 'add ' + LVar + ', 1' + sLineBreak;
+ Result := Result + 'set pc, ' + LFor + sLineBreak;
+ Result := Result + ':' + LEnd + sLineBreak;
+end;
+
end.
View
2  Main.pas
@@ -32,7 +32,7 @@ TForm2 = class(TForm)
implementation
uses
- Optimizer, HeaderMessage;
+ Optimizer, HeaderMessage;
{$R *.dfm}
View
2  Optimizer.pas
@@ -175,7 +175,7 @@ procedure OptimizeMoveOP(ALines: TStrings);
begin
SplitLine(ALines.Strings[i], LOpA, LTargetA, LSourceA);
SplitLine(ALines.Strings[i+1], LOpB, LTargetB, LSourceB);
- if SameText(LOpA, 'set') and (not SameText(LOpB, 'set')) then
+ if SameText(LOpA, 'set') and (not SameText(LOpB, 'set')) and (not SameText(LSourceA, 'pop')) then
begin
if SameText(LTargetA, LSourceB) then
begin
View
4 ProcDeclaration.pas
@@ -61,9 +61,9 @@ procedure TProcDeclaration.AddResultValue;
AddLocal(TVarDeclaration.Create('Result', ResultType));
end;
-constructor TProcDeclaration.Create(AName: string);
+constructor TProcDeclaration.Create(const AName: string);
begin
- inherited;
+ inherited Create(AName);
FParameters := TObjectList<TCodeElement>.Create();
FLocals := TObjectList<TCodeElement>.Create();
end;
View
8 VarDeclaration.pas
@@ -11,6 +11,8 @@ TVarDeclaration = class(TCodeElement)
FDataType: TDataType;
FParamIndex: Integer;
FDefaultValue: string;
+ FID: string;
+ FIsConstant: Boolean;
public
constructor Create(AName: string; AType: TDataType);
function GetAccessIdentifier(): string;
@@ -20,6 +22,7 @@ TVarDeclaration = class(TCodeElement)
property DataType: TDataType read FDataType;
property ParamIndex: Integer read FParamIndex write FParamIndex;
property DefaultValue: string read FDefaultValue write FDefaultValue;
+ property IsConst: Boolean read FIsConstant write FIsConstant;
end;
implementation
@@ -35,6 +38,7 @@ constructor TVarDeclaration.Create(AName: string; AType: TDataType);
FDataType := AType;
FParamIndex := 0;
FDefaultValue := '0x0';
+ FID := GetUniqueID();
end;
function TVarDeclaration.GetAccessIdentifier: string;
@@ -79,7 +83,7 @@ function TVarDeclaration.GetAccessIdentifier: string;
end
else
begin
- Result := Name;
+ Result := Name + FID;
end;
end;
end;
@@ -88,7 +92,7 @@ function TVarDeclaration.GetDCPUSource: string;
var
i, LSize: Integer;
begin
- Result := ':' + Name + ' dat ';
+ Result := ':' + GetAccessIdentifier() + ' dat ';
if DataType.RawType = rtArray then
begin
LSize := DataType.GetRamWordSize();
Please sign in to comment.
Something went wrong with that request. Please try again.