Changeset 14 for branches/DelphiToC

Timestamp:

Apr 9, 2009, 11:04:41 AM (16 years ago)

Author:

george

Message:

• Opraveno: Chyby v uvolňování paměti.
• Opraveno: Program po rozdělení do více souborů opět funguje jako dříve.

Location:

branches/DelphiToC

Files:

• Example.pas (modified) (1 diff)
• UAssemblerSource.pas (modified) (4 diffs)
• UCSource.pas (modified) (1 diff)
• UCodeProducer.pas (modified) (1 diff)
• UMainForm.pas (modified) (3 diffs)
• UPascalCompiler.pas (modified) (3 diffs)
• UPascalParser.pas (modified) (7 diffs)
• UPascalSource.pas (modified) (12 diffs)

branches/DelphiToC/Example.pas

@@ -4 +4 @@
   B: Byte;
 begin
-  A := 'a' + (10 + 2 * 3 + 2) xor 10 / 2;
-  B := 20;
-  while A < 10 do A := A + 1;
-
+  A := 1;
 end;

branches/DelphiToC/UAssemblerSource.pas

@@ -25 +25 @@
 
   TAssemblerProducer = class(TCodeProducer)
-    AssemblyCode: TList; // TList<TAssemblerLine>
-    destructor Destroy; override;
   private
     procedure AddInstruction(LabelName, Instruction, Operand1,
@@ -33 +31 @@
     procedure GenerateExpression(Expression: TExpression; LabelPrefix: string);
     procedure GenerateProgram(ProgramBlock: TProgram);
+  public
+    AssemblyCode: TList; // TList<TAssemblerLine>
+    procedure Produce; override;
+    constructor Create;
+    destructor Destroy; override;
   end;
 
@@ -95 +98 @@
 end;
 *)
+
+constructor TAssemblerProducer.Create;
+begin
+  AssemblyCode := TList.Create;
+end;
 
 destructor TAssemblerProducer.Destroy;
@@ -177 +185 @@
 end;
 
-
-
+procedure TAssemblerProducer.Produce;
+begin
+  inherited;
+  GenerateProgram(ProgramCode);
+end;
 
 end.

branches/DelphiToC/UCSource.pas

@@ -3 +3 @@
 interface
 
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, UPascalSource;
+
+type
+  TCSource = class
+    TextSource: TStringList;
+    PascalSource: TStringList;
+    procedure Generate;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
 implementation
 
+{ TCSource }
+
+constructor TCSource.Create;
+begin
+  TextSource := TStringList.Create;
+end;
+
+destructor TCSource.Destroy;
+begin
+  TextSource.Free;
+  inherited;
+end;
+
+procedure TCSource.Generate;
+begin
+
+end;
+
 end.

branches/DelphiToC/UCodeProducer.pas

@@ -3 +3 @@
 interface
 
+uses
+  UPascalSource;
+
 type
   TCodeProducer = class
+    ProgramCode: TProgram;
     procedure Produce; virtual; abstract;
   end;

branches/DelphiToC/UMainForm.pas

@@ -5 +5 @@
 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
-  Dialogs, StdCtrls, UPascalSource;
+  Dialogs, StdCtrls, UPascalSource, UPascalCompiler, UAssemblerSource;
 
 type
@@ -38 +38 @@
   I: Integer;
 begin
-  Compiler.Compile(Memo1.Lines);
+  MainForm.Memo3.Clear;
+  Compiler.SourceCode.Assign(Memo1.Lines);
+  Compiler.Compile;
   Memo2.Clear;
-  for I := 0 to Compiler.AssemblyCode.Count - 1 do
-    Memo2.Lines.Add(TAssemblerLine(Compiler.AssemblyCode[I]).AsString);
+  with TAssemblerProducer(Compiler.Producer) do
+  for I := 0 to AssemblyCode.Count - 1 do
+    Memo2.Lines.Add(TAssemblerLine(AssemblyCode[I]).AsString);
 end;
 
@@ -66 +69 @@
 
 procedure TMainForm.FormShow(Sender: TObject);
-var
-  I: Integer;
 begin
   Memo1.Lines.LoadFromFile('Example.pas');
-  MainForm.Memo3.Clear;
-  Compiler.Compile(Memo1.Lines);
-  Memo2.Clear;
-  for I := 0 to Compiler.AssemblyCode.Count - 1 do
-    Memo2.Lines.Add(TAssemblerLine(Compiler.AssemblyCode[I]).AsString);
+  Button1Click(Self);
 end;
 

branches/DelphiToC/UPascalCompiler.pas

@@ -10 +10 @@
   TCompiler = class
   private
-    SourceCode: TStringList;
-    CodePosition: Integer;
     ProgramCode: TProgram;
     FOnErrorMessage: TOnErrorMessage;
     procedure ErrorMessage(Text: string);
   public
+    SourceCode: TStringList;
     Parser: TPascalParser;
     Producer: TCodeProducer;
     constructor Create;
-    procedure Compile(SourceCode: TStrings);
+    procedure Compile;
     destructor Destroy; override;
     property OnErrorMessage: TOnErrorMessage read FOnErrorMessage write FOnErrorMessage;
@@ -28 +27 @@
 { TCompiler }
 
-procedure TCompiler.Compile(SourceCode: TStrings);
+procedure TCompiler.Compile;
 begin
-  Self.SourceCode.Assign(SourceCode);
-  CodePosition := 1;
+  Parser.CodePosition := 1;
   Parser.ParseProgram(ProgramCode);
   Producer.Produce;
@@ -39 +37 @@
 begin
   SourceCode := TStringList.Create;
+  ProgramCode := TProgram.Create;
   Producer := TAssemblerProducer.Create;
-  ProgramCode := TProgram.Create;
+  Producer.ProgramCode := ProgramCode;
+  Parser := TPascalParser.Create;
+  Parser.SourceCode := SourceCode;
 end;
 
 destructor TCompiler.Destroy;
-var
-  I: Integer;
 begin
   ProgramCode.Free;
   SourceCode.Free;
+  Parser.Free;
+  Producer.Free;
 end;
 

branches/DelphiToC/UPascalParser.pas

@@ -12 +12 @@
   TPascalParser = class
   private
-    CodePosition: Integer;
     ProgramCode: TProgram;
     FOnErrorMessage: TOnErrorMessage;
     procedure ErrorMessage(Text: string);
   public
+    CodePosition: Integer;
     SourceCode: TStringList;
     function IsAlphanumeric(Character: Char): Boolean;
@@ -32 +32 @@
     procedure ParseModuleUnit(Module: TModule);
     procedure ParseModuleProgram(Module: TModule);
-
     procedure ParseFunction(AFunction: TFunction);
     procedure ParseVariableList(VariableList: TVariableList);
@@ -207 +206 @@
 begin
   with AProgram do begin
-  for I := 0 to Modules.Count - 1 do
-    TModule(Modules[I]).Clear;
-  Modules.Clear;
-  with TModule(Modules[Modules.Add(TModule.Create)]) do begin
-    Name := 'main';
-    with TType(Types[Types.Add(TType.Create)]) do begin
-      Name := 'byte';
-      Size := 1;
-      UsedType := nil;
-    end;
-  end;
+    for I := 0 to Modules.Count - 1 do
+      TModule(Modules[I]).Clear;
+    Modules.Clear;
+    with TModule(Modules[Modules.Add(TModule.Create)]) do begin
+      Name := 'main';
+      with TType(Types[Types.Add(TType.Create)]) do begin
+        Name := 'byte';
+        Size := 1;
+        UsedType := nil;
+      end;
+    end;
     ParseModule(TModule(Modules[0]));
   end;
@@ -294 +293 @@
   Constant: TConstant;
 //  Brackets: Integer;
-  Expressions: TList; // TList<TExpression>;
+  Expressions: TExpressionList;
   I: Integer;
   II: Integer;
 begin
-  Expressions := TList.Create;
+  Expressions := TExpressionList.Create;
   Expressions.Add(TExpression.Create);
   with CommonBlock do begin
@@ -367 +366 @@
         end else
         begin
-                with TExpression(Expressions[Expressions.Count - 1]) do begin
-                  SubItems[1] := TExpression.Create;
-                  TExpression(SubItems[1]).NodeType := ntConstant;
-
-                  if Identifier[1] = '''' then begin
-                    SetLength(TExpression(SubItems[1]).Value, Length(Identifier));
-                    for I := 1 to Length(Identifier) do TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
-                  end else begin
-                    SetLength(TExpression(SubItems[1]).Value, 1);
-                    TExpression(SubItems[1]).Value[0] := StrToInt(Identifier);
-                  end;
-                end;
-                with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
-                  SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
-                end;
+          with TExpression(Expressions[Expressions.Count - 1]) do begin
+            SubItems[1] := TExpression.Create;
+            TExpression(SubItems[1]).NodeType := ntConstant;
+
+            if Identifier[1] = '''' then begin
+              SetLength(TExpression(SubItems[1]).Value, Length(Identifier));
+              for I := 1 to Length(Identifier) do TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
+            end else begin
+              SetLength(TExpression(SubItems[1]).Value, 1);
+              TExpression(SubItems[1]).Value[0] := StrToInt(Identifier);
+            end;
+          end;
+          with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
+            SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
+          end;
         end;
     end;
@@ -400 +399 @@
   end;
   Result := TExpression(Expressions[0]).SubItems[1];
-  TExpression(Expressions[0]).Destroy;
-  TExpression(Expressions[1]).Destroy;
+  TExpression(Expressions[0]).SubItems[1] := nil;
+  TExpression(Expressions[1]).SubItems[0] := nil;
   Expressions.Destroy;
 end;
@@ -623 +622 @@
 end;
 
-
-
-
-
-
-
 end.

branches/DelphiToC/UPascalSource.pas

@@ -24 +24 @@
   TVariableList = class;
   TFunctionList = class;
+  TExpressionList = class;
   TExpression = class;
   TOperationList = class;
@@ -56 +57 @@
     Parent: TCommonBlock;
     function Search(Name: string): TType;
+    destructor Destroy; override;
   end;
 
@@ -67 +69 @@
     Parent: TCommonBlock;
     function Search(Name: string): TConstant;
+    destructor Destroy; override;
   end;
 
@@ -78 +81 @@
     Parent: TCommonBlock;
     function Search(Name: string): TVariable;
+    destructor Destroy; override;
   end;
 
@@ -86 +90 @@
     Value: TValue;
     OperatorName: string;
-    SubItems: TList; // TList<TExpression>
+    SubItems: TExpressionList;
     Associated: Boolean;
     constructor Create;
     destructor Destroy; override;
   end;
+
+  TExpressionList = class(TList)
+    destructor Destroy; override;
+  end;
+
 
   TOperation = class
@@ -177 +186 @@
   for I := 0 to Modules.Count - 1 do
     TModule(Modules[I]).Free;
+  Modules.Free;
   Device.Free;
 end;
@@ -184 +194 @@
 
 { TConstantList }
+
+destructor TConstantList.Destroy;
+var
+  I: Integer;
+begin
+  for I := 0 to Count - 1 do
+    TConstant(Items[I]).Free;
+  inherited;
+end;
 
 function TConstantList.Search(Name: string): TConstant;
@@ -257 +276 @@
 { TTypeList }
 
+destructor TTypeList.Destroy;
+var
+  I: Integer;
+begin
+  for I := 0 to Count - 1 do
+    TType(Items[I]).Free;
+  inherited;
+end;
+
 function TTypeList.Search(Name: string): TType;
 var
@@ -273 +301 @@
 { TVariableList }
 
+destructor TVariableList.Destroy;
+var
+  I: Integer;
+begin
+  for I := 0 to Count - 1 do
+    TVariable(Items[I]).Free;
+  inherited;
+end;
+
 function TVariableList.Search(Name: string): TVariable;
 var
@@ -312 +349 @@
 constructor TExpression.Create;
 begin
-  SubItems := TList.Create;
+  SubItems := TExpressionList.Create;
   SubItems.Count := 2;
 end;
@@ -318 +355 @@
 destructor TExpression.Destroy;
 begin
-  SubItems.Destroy;
+  SubItems.Free;
   inherited;
 end;
@@ -341 +378 @@
 end;
 
+{ TExpressionList }
+
+destructor TExpressionList.Destroy;
+var
+  I: Integer;
+begin
+  for I := 0 to Count - 1 do
+    TExpression(Items[I]).Free;
+  inherited;
+end;
+
 end.