Changeset 19 for branches/DelphiToC


Ignore:
Timestamp:
Apr 9, 2009, 2:08:56 PM (16 years ago)
Author:
george
Message:
  • Přidáno: Nástřel parsování funkcí.
  • Přidáno: Zobrazení stromu struktury programu.
  • Opraveno: Zobrazení chybových hlášení.
Location:
branches/DelphiToC
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • branches/DelphiToC/Example.pas

    r14 r19  
    11program Test;
     2
     3procedure Pokus;
     4begin
     5end;
     6
     7const
     8  Verze: Byte = 10;
    29var
    3   a: Byte;
     10  a: Bpyte;
    411  B: Byte;
     12  sS: Byte;
    513begin
    614  A := 1;
    7 end;
     15end.

  • branches/DelphiToC/UCSource.pas

    r14 r19  
    55uses
    66  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    7   Dialogs, StdCtrls, UPascalSource;
     7  Dialogs, StdCtrls, UPascalSource, UCodeProducer;
    88
    99type
    10   TCSource = class
     10  TCProducer = class(TCodeProducer)
    1111    TextSource: TStringList;
    12     PascalSource: TStringList;
    13     procedure Generate;
     12    procedure Produce; override;
    1413    constructor Create;
    1514    destructor Destroy; override;
     15  private
     16    procedure GenerateCommonBlock(CommonBlock: TCommonBlock;
     17      LabelPrefix: string);
     18    procedure GenerateProgram(ProgramBlock: TProgram);
    1619  end;
    1720
    1821implementation
    1922
    20 { TCSource }
     23{ TCProducer }
    2124
    22 constructor TCSource.Create;
     25constructor TCProducer.Create;
    2326begin
    2427  TextSource := TStringList.Create;
    2528end;
    2629
    27 destructor TCSource.Destroy;
     30destructor TCProducer.Destroy;
    2831begin
    2932  TextSource.Free;
    … …  
    3134end;
    3235
    33 procedure TCSource.Generate;
     36procedure TCProducer.Produce;
    3437begin
    35 
     38  inherited;
     39  GenerateProgram(ProgramCode);
    3640end;
    3741
     42procedure TCProducer.GenerateProgram(ProgramBlock: TProgram);
     43var
     44  I: Integer;
     45begin
     46  with ProgramBlock do
     47  for I := 0 to Modules.Count - 1 do
     48    GenerateCommonBlock(TModule(Modules[I]), '');
     49end;
     50
     51procedure TCProducer.GenerateCommonBlock(CommonBlock: TCommonBlock; LabelPrefix: string);
     52var
     53  I: Integer;
     54  LabelName: string;
     55begin
     56  with CommonBlock do begin
     57    TextSource.Add('void ' + Name + '()');
     58    TextSource.Add('{');
     59
     60    TextSource.Add('}');
     61  end;
     62end;
     63
     64
     65
    3866end.

  • branches/DelphiToC/UMainForm.dfm

    r12 r19  
    33  Top = 0
    44  Caption = 'Pascal Compiler AVR'
    5   ClientHeight = 645
    6   ClientWidth = 750
     5  ClientHeight = 535
     6  ClientWidth = 883
    77  Color = clBtnFace
    88  Font.Charset = DEFAULT_CHARSET
    … …  
    1212  Font.Style = []
    1313  OldCreateOrder = False
     14  Position = poDesktopCenter
    1415  OnClose = FormClose
    1516  OnCreate = FormCreate
    1617  OnDestroy = FormDestroy
    1718  OnShow = FormShow
     19  DesignSize = (
     20    883
     21    535)
    1822  PixelsPerInch = 96
    1923  TextHeight = 13
    … …  
    2125    Left = 8
    2226    Top = 8
    23     Width = 401
    24     Height = 529
     27    Width = 281
     28    Height = 424
     29    Anchors = [akLeft, akTop, akBottom]
    2530    Font.Charset = DEFAULT_CHARSET
    2631    Font.Color = clWindowText
    … …  
    3136    ScrollBars = ssBoth
    3237    TabOrder = 0
     38    ExplicitHeight = 435
    3339  end
    3440  object Button1: TButton
    3541    Left = 8
    36     Top = 615
     42    Top = 510
    3743    Width = 75
    3844    Height = 22
     45    Anchors = [akLeft, akBottom]
    3946    Caption = 'Kompilovat'
    4047    TabOrder = 1
    4148    OnClick = Button1Click
     49    ExplicitTop = 615
    4250  end
    4351  object Memo2: TMemo
    44     Left = 415
     52    Left = 600
    4553    Top = 8
    46     Width = 321
    47     Height = 529
     54    Width = 277
     55    Height = 424
     56    Anchors = [akLeft, akTop, akRight, akBottom]
    4857    Font.Charset = DEFAULT_CHARSET
    4958    Font.Color = clWindowText
    … …  
    5463    ScrollBars = ssBoth
    5564    TabOrder = 2
     65    ExplicitWidth = 281
     66    ExplicitHeight = 435
    5667  end
    5768  object Memo3: TMemo
    5869    Left = 8
    59     Top = 543
    60     Width = 728
     70    Top = 438
     71    Width = 869
    6172    Height = 66
     73    Anchors = [akLeft, akRight, akBottom]
    6274    ScrollBars = ssBoth
    6375    TabOrder = 3
     76    ExplicitTop = 543
     77    ExplicitWidth = 728
     78  end
     79  object TreeView1: TTreeView
     80    Left = 296
     81    Top = 8
     82    Width = 298
     83    Height = 424
     84    Anchors = [akLeft, akTop, akBottom]
     85    Indent = 19
     86    TabOrder = 4
    6487  end
    6588end

  • branches/DelphiToC/UMainForm.pas

    r14 r19  
    55uses
    66  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    7   Dialogs, StdCtrls, UPascalSource, UPascalCompiler, UAssemblerSource;
     7  Dialogs, StdCtrls, UPascalSource, UPascalCompiler, UAssemblerSource,
     8  UCSource, ComCtrls;
    89
    910type
    … …  
    1314    Memo2: TMemo;
    1415    Memo3: TMemo;
     16    TreeView1: TTreeView;
    1517    procedure FormShow(Sender: TObject);
    1618    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    … …  
    2022    procedure ErrorMessage(Text: string);
    2123  private
    22     { Private declarations }
     24    procedure FillTreeView;
    2325  public
    2426    Compiler: TCompiler;
    … …  
    4143  Compiler.SourceCode.Assign(Memo1.Lines);
    4244  Compiler.Compile;
     45  FillTreeView;
    4346  Memo2.Clear;
    44   with TAssemblerProducer(Compiler.Producer) do
    45   for I := 0 to AssemblyCode.Count - 1 do
    46     Memo2.Lines.Add(TAssemblerLine(AssemblyCode[I]).AsString);
     47  if Compiler.Producer is TAssemblerProducer then begin
     48    with TAssemblerProducer(Compiler.Producer) do
     49    for I := 0 to AssemblyCode.Count - 1 do
     50      Memo2.Lines.Add(TAssemblerLine(AssemblyCode[I]).AsString);
     51  end else
     52  if Compiler.Producer is TCProducer then begin
     53    with TCProducer(Compiler.Producer) do
     54      Memo2.Lines.Assign(TextSource);
     55  end;
    4756end;
    4857
    … …  
    5059begin
    5160  MainForm.Memo3.Lines.Add(Text);
     61end;
     62
     63procedure TMainForm.FillTreeView;
     64var
     65  NewNode: TTreeNode;
     66  NewNode2: TTreeNode;
     67  ModuleNode: TTreeNode;
     68  I: Integer;
     69  M: Integer;
     70begin
     71  with TreeView1, Items, Compiler do begin
     72    BeginUpdate;
     73    Clear;
     74    AddChild(nil, 'Projekt');
     75    for M := 0 to ProgramCode.Modules.Count - 1 do
     76      with TModule(ProgramCode.Modules[M]) do begin
     77        ModuleNode := AddChild(TopItem, Name);
     78        NewNode := AddChild(ModuleNode, 'Typy');
     79        for I := 0 to Types.Count - 1 do
     80        with TType(Types[I]) do
     81          NewNode2 := AddChild(NewNode, Name);
     82        NewNode := AddChild(ModuleNode, 'Funkce');
     83        for I := 0 to Methods.Count - 1 do
     84        with TFunction(Methods[I]) do
     85          NewNode2 := AddChild(NewNode, Name);
     86        NewNode := AddChild(ModuleNode, 'Promìnné');
     87        for I := 0 to Variables.Count - 1 do
     88        with TVariable(Variables[I]) do
     89          NewNode2 := AddChild(NewNode, Name);
     90        NewNode := AddChild(ModuleNode, 'Konstanty');
     91        for I := 0 to Constants.Count - 1 do
     92        with TConstant(Constants[I]) do
     93          NewNode2 := AddChild(NewNode, Name);
     94        NewNode := AddChild(ModuleNode, 'Program');
     95      end;
     96    TopItem.Expand(True);
     97    EndUpdate;
     98  end;
    5299end;
    53100

  • branches/DelphiToC/UPascalCompiler.pas

    r14 r19  
    55uses
    66  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    7   Dialogs, StdCtrls, UPascalSource, UCodeProducer, UPascalParser, UAssemblerSource;
     7  Dialogs, StdCtrls, UPascalSource, UCodeProducer, UPascalParser, UAssemblerSource,
     8  UCSource;
    89
    910type
    1011  TCompiler = class
    1112  private
    12     ProgramCode: TProgram;
    1313    FOnErrorMessage: TOnErrorMessage;
    1414    procedure ErrorMessage(Text: string);
    1515  public
     16    ProgramCode: TProgram;
    1617    SourceCode: TStringList;
    1718    Parser: TPascalParser;
    … …  
    3839  SourceCode := TStringList.Create;
    3940  ProgramCode := TProgram.Create;
    40   Producer := TAssemblerProducer.Create;
     41  Producer := TCProducer.Create;
    4142  Producer.ProgramCode := ProgramCode;
    4243  Parser := TPascalParser.Create;
    4344  Parser.SourceCode := SourceCode;
     45  Parser.OnErrorMessage := ErrorMessage;
    4446end;
    4547

  • branches/DelphiToC/UPascalParser.pas

    r14 r19  
    2828    function IsOperator(Text: string): Boolean;
    2929    procedure ParseProgram(AProgram: TProgram);
    30     procedure ParseFunctionList(FunctionList: TFunctionList);
    3130    procedure ParseModule(Module: TModule);
    3231    procedure ParseModuleUnit(Module: TModule);
    3332    procedure ParseModuleProgram(Module: TModule);
    34     procedure ParseFunction(AFunction: TFunction);
     33    procedure ParseFunction(FunctionList: TFunctionList);
    3534    procedure ParseVariableList(VariableList: TVariableList);
    3635    procedure ParseVariable(Variable: TVariable);
    … …  
    3938    procedure ParseTypeList(TypeList: TTypeList);
    4039    procedure ParseType(AType: TType);
    41     procedure ParseCommonBlockDefinitions(CommonBlock: TCommonBlock);
     40    procedure ParseCommonBlockDefinitions(CommonBlock: TCommonBlock; EndSymbol: string = ';');
    4241    function ParseCommonBlockExpression(CommonBlock: TCommonBlock): TExpression;
    4342    procedure ParseCommonBlockProgramCode(CommonBlock: TCommonBlock);
    4443    procedure ParseCommonBlockOperation(CommonBlock: TCommonBlock);
    45     procedure Parse;
     44    procedure Log(Text: string);
    4645    property OnErrorMessage: TOnErrorMessage read FOnErrorMessage write FOnErrorMessage;
    4746  end;
    … …  
    5857procedure TPascalParser.Expect(Code: string);
    5958begin
     59  Log('Expected: ' + Code + '  Readed: ' + NextCode);
    6060  if NextCode <> Code then begin
    6161    ErrorMessage('Expected ' + Code + ' but ' + NextCode + ' found.');
    … …  
    112112begin
    113113  Result := (Character = ' ') or (Character = #13) or (Character = #10);
     114end;
     115
     116procedure TPascalParser.Log(Text: string);
     117const
     118  LogFileName = 'ParseLog.txt';
     119var
     120  LogFile: TextFile;
     121begin
     122  AssignFile(LogFile, LogFileName);
     123  if FileExists(LogFileName) then Append(LogFile)
     124    else Rewrite(LogFile);
     125  WriteLn(LogFile, Text);
     126  CloseFile(LogFile);
    114127end;
    115128
    … …  
    189202begin
    190203  Result := NextCode(True);
    191 end;
    192 
    193 procedure TPascalParser.ParseFunction(AFunction: TFunction);
    194 begin
    195   with AFunction do begin
    196     if NextCode = 'var' then ParseVariableList(TVariableList(Variables))
    197     else if NextCode = 'const' then ParseConstantList(TConstantList(Constants))
    198     else if NextCode = 'type' then ParseTypeList(TTypeList(Types))
    199     else ParseProgram(ProgramCode);
     204  Log('Read: ' + Result);
     205end;
     206
     207procedure TPascalParser.ParseFunction(FunctionList: TFunctionList);
     208begin
     209  with FunctionList do begin
     210    with TFunction(Items[Add(TFunction.Create)]) do begin
     211      Expect('procedure');
     212      Name := ReadCode;
     213      Expect(';');
     214      ParseCommonBlockDefinitions(Items[Count - 1]);
     215    end;
    200216  end;
    201217end;
    … …  
    205221  I: Integer;
    206222begin
     223  Log('==== Parse start ====');
    207224  with AProgram do begin
    208225    for I := 0 to Modules.Count - 1 do
    … …  
    227244
    228245procedure TPascalParser.ParseConstantList(ConstantList: TConstantList);
    229 begin
    230 //  Compiler.Expect('const');
    231 //  while Compiler.IsIdentificator(Compiler.NextCode) do
    232 //    TConstant(Items[Add(TConstant.Create)]).Parse(Compiler);
     246var
     247  Identifiers: TStringList;
     248  NewValueType: TType;
     249  TypeName: string;
     250  ConstantName: string;
     251  Constant: TConstant;
     252  I: Integer;
     253  ConstantValue: string;
     254begin
     255  Identifiers := TStringList.Create;
     256  with ConstantList do begin
     257    Expect('const');
     258    while IsIdentificator(NextCode) do begin
     259      ConstantName := ReadCode;
     260      Constant := Search(ConstantName);
     261      if not Assigned(Constant) then begin
     262        Identifiers.Add(ConstantName);
     263        while NextCode = ',' do begin
     264          Expect(',');
     265          Identifiers.Add(ReadCode);
     266        end;
     267      end else ErrorMessage('Pøedefinování existující konstanty.');
     268      Expect(':');
     269      TypeName := ReadCode;
     270      NewValueType := Parent.Types.Search(TypeName);
     271      Expect('=');
     272      ConstantValue := ReadCode;
     273      Expect(';');
     274
     275      if NewValueType = nil then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
     276        else for I := 0 to Identifiers.Count - 1 do
     277          with TConstant(Items[Add(TConstant.Create)]) do begin
     278            Name := Identifiers[I];
     279            ValueType := NewValueType;
     280            Value := ConstantValue;
     281          end;
     282    end;
     283  end;
     284  Identifiers.Destroy;
    233285end;
    234286
    … …  
    253305      end;
    254306    end;
    255     ParseCommonBlockDefinitions(Module);
     307    ParseCommonBlockDefinitions(Module, '.');
    256308  end;
    257309end;
    … …  
    266318end;
    267319
    268 procedure TPascalParser.Parse;
    269 begin
    270 
    271 end;
    272 
    273 procedure TPascalParser.ParseCommonBlockDefinitions(CommonBlock: TCommonBlock);
     320procedure TPascalParser.ParseCommonBlockDefinitions(CommonBlock: TCommonBlock; EndSymbol: string = ';');
    274321begin
    275322  with CommonBlock do begin
    276     while NextCode <> '.' do begin
     323    while NextCode <> EndSymbol do begin
    277324      if NextCode = 'var' then ParseVariableList(TVariableList(Variables))
    278325      else if NextCode = 'const' then ParseConstantList(TConstantList(Constants))
    279326      else if NextCode = 'type' then ParseTypeList(TTypeList(Types))
     327      else if NextCode = 'procedure' then ParseFunction(Methods)
    280328      else begin
    281329        ParseCommonBlockProgramCode(CommonBlock);
    … …  
    283331      end;
    284332    end;
     333    Expect(EndSymbol);
    285334  end;
    286335end;
    … …  
    371420
    372421            if Identifier[1] = '''' then begin
    373               SetLength(TExpression(SubItems[1]).Value, Length(Identifier));
    374               for I := 1 to Length(Identifier) do TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
     422              TExpression(SubItems[1]).Value := Identifier;
     423              //SetLength(TExpression(SubItems[1]).Value, Length(Identifier));
     424              //for I := 1 to Length(Identifier) do
     425              //  TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
    375426            end else begin
    376               SetLength(TExpression(SubItems[1]).Value, 1);
    377               TExpression(SubItems[1]).Value[0] := StrToInt(Identifier);
     427              //SetLength(TExpression(SubItems[1]).Value, 1);
     428              //TExpression(SubItems[1]).Value[0] := StrToInt(Identifier);
    378429            end;
    379430          end;
    … …  
    518569            with TExpression(SubItems[1]) do begin
    519570              NodeType := ntConstant;
    520               SetLength(Value, 1);
    521               Value[0] := 1;
     571              //SetLength(Value, 1);
     572              //Value[0] := 1;
     573              Value := 1;
    522574            end;
    523575          end;
    … …  
    617669end;
    618670
    619 procedure TPascalParser.ParseFunctionList(FunctionList: TFunctionList);
    620 begin
    621 
    622 end;
    623 
    624671end.

  • branches/DelphiToC/UPascalSource.pas

    r14 r19  
    1717  TNodeType = (ntNone, ntVariable, ntFunction, ntConstant, ntOperator);
    1818
    19   TValue = array of Byte;
     19  TValue = Variant; //array of Byte;
    2020
    2121  TCommonBlock = class;
    … …  
    2828  TOperationList = class;
    2929  TFunction = class;
     30  TVariable = class;
     31  TConstant = class;
    3032
    3133  TDevice = class
    3234    Family: string;
    3335    Memory: array[TMemoryType] of Integer;
     36  end;
     37
     38  TContext = class
     39
     40  end;
     41
     42  TCommandList = class;
     43
     44  TCommand = class
     45
     46  end;
     47
     48  TBeginEnd = class(TCommand)
     49    Commands: TCommandList;
     50  end;
     51
     52  TWhileDo = class(TCommand)
     53    Condition: TExpression;
     54    Command: TCommand;
     55  end;
     56
     57  WithDo = class(TCommand)
     58    Context: TContext;
     59    Command: TCommand;
     60  end;
     61
     62  RepeatUntil = class(TCommand)
     63    Block: TCommandList;
     64    Condition: TExpression;
     65  end;
     66
     67  ForToDo = class(TCommand)
     68    ControlVariable: TVariable;
     69    Start: TExpression;
     70    Stop: TExpression;
     71    Command: TCommand;
     72  end;
     73
     74  IfThenElse = class(TCommand)
     75    Condition: TExpression;
     76    Command: TCommand;
     77    ElseCommand: TCommand;
     78  end;
     79
     80  TCaseOfEndBranche = class
     81    Constant: TConstant;
     82    Command: TCommand;
     83  end;
     84
     85  CaseOfEnd = class(TCommand)
     86    Expression: TExpression;
     87    Branches: TList; // TList<TCaseOfEndBranche>
     88    ElseCommand: TCommand;
     89  end;
     90
     91  TryFinally = class(TCommand)
     92    Block: TCommandList;
     93    FinallyBlock: TCommandList;
     94  end;
     95
     96  TryExcept = class(TCommand)
     97    Block: TCommandList;
     98    ExceptBlock: TCommandList;
     99  end;
     100
     101
     102
     103  TCommandList = class(TList)
     104
    34105  end;
    35106
    … …  
    54125  end;
    55126
     127  TTypeRecordItem = class
     128    Name: string;
     129    DataType: TType;
     130  end;
     131
     132  TTypeRecord = class
     133    Items: TList; // TList<TTypeRecordItem>
     134  end;
     135
     136  TTypeArray = class
     137    //Range: TTypeRange;
     138    ItemType: TType;
     139  end;
     140
    56141  TTypeList = class(TList)
    57142    Parent: TCommonBlock;
    … …  
    100185  end;
    101186
    102 
    103187  TOperation = class
    104188    Instruction: TInstruction;
    … …  
    125209    Parent: TCommonBlock;
    126210    function Search(Name: string): TFunction;
     211    destructor Destroy; override;
    127212  end;
    128213
    … …  
    331416{ TFunctionList }
    332417
     418destructor TFunctionList.Destroy;
     419var
     420  I: Integer;
     421begin
     422  for I := 0 to Count - 1 do
     423    TFunction(Items[I]).Free;
     424  inherited;
     425end;
     426
    333427function TFunctionList.Search(Name: string): TFunction;
    334428var
Note: See TracChangeset for help on using the changeset viewer.