Changeset 201


Ignore:
Timestamp:
Apr 16, 2020, 7:40:38 PM (5 years ago)
Author:
chronos
Message:
  • Fixed: Memory leaks.
Location:
branches/interpreter2
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • branches/interpreter2

    • Property svn:ignore set to
      lib
      interpreter
      interpreter.lps
      interpreter.res
      heaptrclog.trc

  • branches/interpreter2/UExecutor.pas

    r200 r201  
    266266  Expression: TExpression): string;
    267267begin
    268   if Assigned(Expression.Variable) then begin
    269     Result := Block.Variables.SearchByVariable(Expression.Variable).Value;
     268  if Assigned(Expression.VariableRef) then begin
     269    Result := Block.Variables.SearchByVariable(Expression.VariableRef).Value;
    270270  end else
    271   if Assigned(Expression.Constant) then begin
    272     Result := Expression.Constant.Value;
     271  if Assigned(Expression.ConstantRef) then begin
     272    Result := Expression.ConstantRef.Value;
    273273  end else
    274274  if Assigned(Expression.FunctionCall) then begin

  • branches/interpreter2/UFormMain.lfm

    r200 r201  
    99  DesignTimePPI = 144
    1010  OnActivate = FormActivate
     11  OnClose = FormClose
     12  OnDestroy = FormDestroy
    1113  OnShow = FormShow
    1214  LCLVersion = '2.0.2.0'

  • branches/interpreter2/UFormMain.pas

    r200 r201  
    2323    procedure ButtonRunClick(Sender: TObject);
    2424    procedure FormActivate(Sender: TObject);
     25    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     26    procedure FormDestroy(Sender: TObject);
    2527    procedure FormShow(Sender: TObject);
    2628  private
    … …  
    5658end;
    5759
     60procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
     61begin
     62
     63end;
     64
     65procedure TFormMain.FormDestroy(Sender: TObject);
     66begin
     67  if Assigned(Prog) then Prog.Free;
     68end;
     69
    5870procedure TFormMain.FormShow(Sender: TObject);
    5971begin
    … …  
    8597  Parser.Source := MemoSource.Lines.Text;
    8698  Parser.Parse;
     99  if Assigned(Prog) then Prog.Free;
    87100  Prog := Parser.Prog;
    88101  Parser.Free;

  • branches/interpreter2/UInterpreter.pas

    r200 r201  
    1818  public
    1919    Source: string;
     20    procedure Compile;
    2021    procedure Run;
    2122    constructor Create;
    … …  
    2627
    2728{ TInterpreter }
     29
     30procedure TInterpreter.Compile;
     31begin
     32  Parser.Source := Source;
     33  Parser.Parse;
     34end;
    2835
    2936procedure TInterpreter.Run;

  • branches/interpreter2/UParser.pas

    r200 r201  
    1616    FOnError: TErrorEvent;
    1717    Tokenizer: TTokenizer;
    18     function ParseBeginEnd(Block: TBlock; var BeginEnd: TBeginEnd): Boolean;
    19     function ParseFunctionCall(Block: TBlock; var FunctionCall: TFunctionCall): Boolean;
    20     function ParseCommand(Block: TBlock; var Command: TCommand): Boolean;
    21     function ParseProgram(SystemBlock: TBlock; var Prog: TProgram): Boolean;
    22     function ParseBlock(ParentBlock: TBlock; var Block: TBlock): Boolean;
    23     function ParseAssignment(Block: TBlock; var Assignment: TAssignment): Boolean;
    24     function ParseExpression(Block: TBlock; var Expression: TExpression): Boolean;
    25     function ParseIfThenElse(Block: TBlock; var IfThenElse: TIfThenElse): Boolean;
    26     function ParseWhileDo(Block: TBlock; var WhileDo: TWhileDo): Boolean;
     18    function ParseBeginEnd(Block: TBlock; out BeginEnd: TBeginEnd): Boolean;
     19    function ParseFunctionCall(Block: TBlock; out FunctionCall: TFunctionCall): Boolean;
     20    function ParseCommand(Block: TBlock; out Command: TCommand): Boolean;
     21    function ParseProgram(SystemBlock: TBlock; out Prog: TProgram): Boolean;
     22    function ParseBlock(ParentBlock: TBlock; out Block: TBlock): Boolean;
     23    function ParseVarBlock(Block: TBlock): Boolean;
     24    function ParseConstBlock(Block: TBlock): Boolean;
     25    function ParseAssignment(Block: TBlock; out Assignment: TAssignment): Boolean;
     26    function ParseExpression(Block: TBlock; out Expression: TExpression): Boolean;
     27    function ParseIfThenElse(Block: TBlock; out IfThenElse: TIfThenElse): Boolean;
     28    function ParseWhileDo(Block: TBlock; out WhileDo: TWhileDo): Boolean;
    2729    procedure TokenizerError(Pos: TPoint; Text: string);
    2830    procedure InitSystemBlock(Block: TBlock);
    … …  
    4244{ TParser }
    4345
    44 function TParser.ParseBeginEnd(Block: TBlock; var BeginEnd: TBeginEnd): Boolean;
     46function TParser.ParseBeginEnd(Block: TBlock; out BeginEnd: TBeginEnd): Boolean;
    4547var
    4648  Command: TCommand;
    … …  
    6466end;
    6567
    66 function TParser.ParseFunctionCall(Block: TBlock; var FunctionCall: TFunctionCall
     68function TParser.ParseFunctionCall(Block: TBlock; out FunctionCall: TFunctionCall
    6769  ): Boolean;
    6870var
    … …  
    9799end;
    98100
    99 function TParser.ParseCommand(Block: TBlock; var Command: TCommand): Boolean;
     101function TParser.ParseCommand(Block: TBlock; out Command: TCommand): Boolean;
    100102var
    101103  BeginEnd: TBeginEnd;
    … …  
    127129end;
    128130
    129 function TParser.ParseProgram(SystemBlock: TBlock; var Prog: TProgram): Boolean;
     131function TParser.ParseProgram(SystemBlock: TBlock; out Prog: TProgram): Boolean;
    130132var
    131133  Block: TBlock;
    … …  
    134136  Result := False;
    135137  Prog := TProgram.Create;
     138  Prog.SystemBlock.Free;
    136139  Prog.SystemBlock := SystemBlock;
    137140  if Tokenizer.CheckNext('program', tkKeyword) then begin
    … …  
    144147  if ParseBlock(SystemBlock, Block) then begin
    145148    Result := True;
     149    Prog.Block.Free;
    146150    Prog.Block := Block;
    147151    Tokenizer.Expect('.', tkSpecialSymbol);
    … …  
    152156end;
    153157
    154 function TParser.ParseBlock(ParentBlock: TBlock; var Block: TBlock): Boolean;
    155 var
    156   Token: TToken;
    157   Variable: TVariable;
    158   Constant: TConstant;
    159 begin
     158function TParser.ParseBlock(ParentBlock: TBlock; out Block: TBlock): Boolean;
     159var
     160  BeginEnd: TBeginEnd;
     161begin
     162  Result := False;
    160163  Block := TBlock.Create;
    161164  Block.Parent := ParentBlock;
     165  ParseVarBlock(Block);
     166  ParseConstBlock(Block);
     167  if ParseBeginEnd(Block, BeginEnd) then begin
     168    Result := True;
     169    Block.BeginEnd.Free;
     170    Block.BeginEnd := BeginEnd;
     171  end else Block.Free;
     172end;
     173
     174function TParser.ParseVarBlock(Block: TBlock): Boolean;
     175var
     176  Token: TToken;
     177  Variable: TVariable;
     178begin
    162179  if Tokenizer.CheckNext('var', tkKeyword) then begin
     180    Result := True;
    163181    Tokenizer.Expect('var', tkKeyword);
    164182    while Tokenizer.CheckNextKind(tkIdentifier) do begin
    … …  
    177195      end;
    178196    end;
    179   end;
     197  end else Result := False;
     198end;
     199
     200function TParser.ParseConstBlock(Block: TBlock): Boolean;
     201var
     202  Token: TToken;
     203  Constant: TConstant;
     204begin
    180205  if Tokenizer.CheckNext('const', tkKeyword) then begin
     206    Result := True;
    181207    Tokenizer.Expect('const', tkKeyword);
    182208    while Tokenizer.CheckNextKind(tkIdentifier) do begin
    … …  
    200226      end;
    201227    end;
    202   end;
    203   Result := ParseBeginEnd(Block, Block.BeginEnd);
    204   //if not Result then Block.Free;
    205 end;
    206 
    207 function TParser.ParseAssignment(Block: TBlock; var Assignment: TAssignment): Boolean;
     228  end else Result := False;
     229end;
     230
     231function TParser.ParseAssignment(Block: TBlock; out Assignment: TAssignment): Boolean;
    208232var
    209233  Token: TToken;
    210234  Variable: TVariable;
     235  Expression: TExpression;
    211236begin
    212237  Result := False;
    … …  
    220245      Assignment.Variable := Variable;
    221246      Tokenizer.Expect(':=', tkSpecialSymbol);
    222       ParseExpression(Block, Assignment.Expression);
     247      if ParseExpression(Block, Expression) then begin
     248        Assignment.Expression.Free;
     249        Assignment.Expression := Expression;
     250      end;
    223251    end else Error('Variable ' + Token.Text + ' not defined.');
    224252  end;
    225253end;
    226254
    227 function TParser.ParseExpression(Block: TBlock; var Expression: TExpression
     255function TParser.ParseExpression(Block: TBlock; out Expression: TExpression
    228256  ): Boolean;
    229257var
    … …  
    239267      Result := True;
    240268      Expression := TExpression.Create;
    241       Expression.Variable := Variable;
     269      Expression.VariableRef := Variable;
    242270    end else begin
    243271      Constant := Block.Constants.SearchByName(Token.Text);
    … …  
    245273        Result := True;
    246274        Expression := TExpression.Create;
    247         Expression.Constant := Constant;
     275        Expression.ConstantRef := Constant;
    248276      end;
    249277    end;
    … …  
    251279  if Token.Kind = tkNumber then begin
    252280    Result := True;
     281    Constant := Block.Constants.AddNew('_C' + IntToStr(Block.Constants.Count));
     282    Constant.Value := Token.Text;
    253283    Expression := TExpression.Create;
    254     Expression.Constant := TConstant.Create;
    255     Expression.Constant.Value := Token.Text;
     284    Expression.ConstantRef := Constant;
    256285  end else
    257286  if Token.Kind = tkString then begin
    258287    Result := True;
     288    Constant := Block.Constants.AddNew('_C' + IntToStr(Block.Constants.Count));
     289    Constant.Value := Token.Text;
    259290    Expression := TExpression.Create;
    260     Expression.Constant := TConstant.Create;
    261     Expression.Constant.Value := Token.Text;
    262   end;
    263 end;
    264 
    265 function TParser.ParseIfThenElse(Block: TBlock; var IfThenElse: TIfThenElse
     291    Expression.ConstantRef := Constant;
     292  end;
     293end;
     294
     295function TParser.ParseIfThenElse(Block: TBlock; out IfThenElse: TIfThenElse
    266296  ): Boolean;
    267297var
    … …  
    275305    IfThenElse := TIfThenElse.Create;
    276306    if ParseExpression(Block, Expression) then begin
     307      IfThenElse.Expression.Free;
    277308      IfThenElse.Expression := Expression;
    278309      Tokenizer.Expect('then', tkKeyword);
    279310      if ParseCommand(Block, Command) then begin
     311        IfThenElse.CommandThen.Free;
    280312        IfThenElse.CommandThen := Command;
    281313        if Tokenizer.CheckNext('else', tkKeyword) then begin
    282314          Tokenizer.Expect('else', tkKeyword);
    283315          if ParseCommand(Block, Command) then begin
     316            IfThenElse.CommandElse.Free;
    284317            IfThenElse.CommandElse := Command;
    285318          end else Error('Expected command');
    … …  
    290323end;
    291324
    292 function TParser.ParseWhileDo(Block: TBlock; var WhileDo: TWhileDo): Boolean;
     325function TParser.ParseWhileDo(Block: TBlock; out WhileDo: TWhileDo): Boolean;
    293326var
    294327  Expression: TExpression;
    … …  
    301334    WhileDo := TWhileDo.Create;
    302335    if ParseExpression(Block, Expression) then begin
     336      WhileDo.Expression.Free;
    303337      WhileDo.Expression := Expression;
    304338      Tokenizer.Expect('do', tkKeyword);
    305339      if ParseCommand(Block, Command) then begin
     340        WhileDo.Command.Free;
    306341        WhileDo.Command := Command;
    307342      end else Error('Expected command');

  • branches/interpreter2/USource.pas

    r200 r201  
    3030  TConstants = class(TObjectList)
    3131    function SearchByName(Name: string): TConstant;
     32    function AddNew(Name: string): TConstant;
    3233  end;
    3334
    … …  
    6667
    6768  TExpression = class
    68     Variable: TVariable;
    69     Constant: TConstant;
     69    VariableRef: TVariable;
     70    ConstantRef: TConstant;
    7071    FunctionCall: TFunctionCall;
    7172  end;
    … …  
    7374  TExpressions = class(TObjectList)
    7475  end;
     76
     77  { TAssignment }
    7578
    7679  TAssignment = class(TCommand)
    7780    Variable: TVariable;
    7881    Expression: TExpression;
    79   end;
     82    constructor Create;
     83    destructor Destroy; override;
     84  end;
     85
     86  { TIfThenElse }
    8087
    8188  TIfThenElse = class(TCommand)
    … …  
    8390    CommandThen: TCommand;
    8491    CommandElse: TCommand;
    85   end;
     92    constructor Create;
     93    destructor Destroy; override;
     94  end;
     95
     96  { TWhileDo }
    8697
    8798  TWhileDo = class(TCommand)
    8899    Expression: TExpression;
    89100    Command: TCommand;
     101    constructor Create;
     102    destructor Destroy; override;
    90103  end;
    91104
    … …  
    98111    Functions: TFunctions;
    99112    BeginEnd: TBeginEnd;
     113    procedure Clear;
    100114    function GetFunction(Name: string): TFunction;
    101115    constructor Create;
    … …  
    116130implementation
    117131
     132{ TAssignment }
     133
     134constructor TAssignment.Create;
     135begin
     136  Variable := nil;
     137  Expression := TExpression.Create;
     138end;
     139
     140destructor TAssignment.Destroy;
     141begin
     142  Variable := nil;
     143  Expression.Free;
     144  inherited Destroy;
     145end;
     146
     147{ TIfThenElse }
     148
     149constructor TIfThenElse.Create;
     150begin
     151  Expression := TExpression.Create;
     152  CommandThen := TCommand.Create;
     153  CommandElse := TCommand.Create;
     154end;
     155
     156destructor TIfThenElse.Destroy;
     157begin
     158  Expression.Free;
     159  CommandThen.Free;
     160  CommandElse.Free;
     161  inherited Destroy;
     162end;
     163
     164{ TWhileDo }
     165
     166constructor TWhileDo.Create;
     167begin
     168  Expression := TExpression.Create;
     169  Command := TCommand.Create;
     170end;
     171
     172destructor TWhileDo.Destroy;
     173begin
     174  Expression.Free;
     175  Command.Free;
     176  inherited Destroy;
     177end;
     178
    118179{ TFunctionCall }
    119180
    … …  
    160221end;
    161222
     223function TConstants.AddNew(Name: string): TConstant;
     224begin
     225  Result := TConstant.Create;
     226  Result.Name := Name;
     227  Add(Result);
     228end;
     229
    162230{ TVariables }
    163231
    … …  
    174242{ TBlock }
    175243
     244procedure TBlock.Clear;
     245begin
     246  Functions.Clear;
     247  Constants.Clear;
     248  Variables.Clear;
     249end;
     250
    176251function TBlock.GetFunction(Name: string): TFunction;
    177252begin

  • branches/interpreter2/interpreter.lpi

    r200 r201  
    1515      <Icon Value="0"/>
    1616    </General>
    17     <BuildModes Count="1">
    18       <Item1 Name="Default" Default="True"/>
     17    <BuildModes Count="2">
     18      <Item1 Name="Debug" Default="True"/>
     19      <Item2 Name="Release">
     20        <CompilerOptions>
     21          <Version Value="11"/>
     22          <Target>
     23            <Filename Value="interpreter"/>
     24          </Target>
     25          <SearchPaths>
     26            <IncludeFiles Value="$(ProjOutDir)"/>
     27            <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
     28          </SearchPaths>
     29          <Parsing>
     30            <SyntaxOptions>
     31              <SyntaxMode Value="Delphi"/>
     32              <CStyleOperator Value="False"/>
     33              <AllowLabel Value="False"/>
     34              <CPPInline Value="False"/>
     35            </SyntaxOptions>
     36          </Parsing>
     37          <CodeGeneration>
     38            <SmartLinkUnit Value="True"/>
     39            <Optimizations>
     40              <OptimizationLevel Value="3"/>
     41            </Optimizations>
     42          </CodeGeneration>
     43          <Linking>
     44            <Debugging>
     45              <GenerateDebugInfo Value="False"/>
     46            </Debugging>
     47            <LinkSmart Value="True"/>
     48            <Options>
     49              <Win32>
     50                <GraphicApplication Value="True"/>
     51              </Win32>
     52            </Options>
     53          </Linking>
     54        </CompilerOptions>
     55      </Item2>
    1956    </BuildModes>
    2057    <PublishOptions>
    … …  
    72109    <SearchPaths>
    73110      <IncludeFiles Value="$(ProjOutDir)"/>
    74       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     111      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    75112    </SearchPaths>
    76113    <Parsing>
    77114      <SyntaxOptions>
    78115        <SyntaxMode Value="Delphi"/>
     116        <CStyleOperator Value="False"/>
     117        <IncludeAssertionCode Value="True"/>
     118        <AllowLabel Value="False"/>
     119        <CPPInline Value="False"/>
    79120      </SyntaxOptions>
    80121    </Parsing>
     122    <CodeGeneration>
     123      <Checks>
     124        <IOChecks Value="True"/>
     125        <RangeChecks Value="True"/>
     126        <OverflowChecks Value="True"/>
     127        <StackChecks Value="True"/>
     128      </Checks>
     129      <VerifyObjMethodCallValidity Value="True"/>
     130    </CodeGeneration>
    81131    <Linking>
     132      <Debugging>
     133        <UseHeaptrc Value="True"/>
     134      </Debugging>
    82135      <Options>
    83136        <Win32>

  • branches/interpreter2/interpreter.lpr

    r200 r201  
    77  cthreads,
    88  {$ENDIF}{$ENDIF}
    9   Interfaces, // this includes the LCL widgetset
     9  Interfaces, SysUtils, // this includes the LCL widgetset
    1010  Forms, UFormMain, UParser, UTokenizer, USource, UExecutor, UInterpreter
    1111  { you can add units after this };
    … …  
    1313{$R *.res}
    1414
     15{$if declared(UseHeapTrace)}
     16const
     17  HeapTraceLog = 'heaptrclog.trc';
     18{$ENDIF}
     19
    1520begin
     21  {$if declared(UseHeapTrace)}
     22  DeleteFile(ExtractFilePath(ParamStr(0)) + HeapTraceLog);
     23  SetHeapTraceOutput(ExtractFilePath(ParamStr(0)) + HeapTraceLog);
     24  {$ENDIF}
    1625  RequireDerivedFormResource:=True;
    1726  Application.Scaled:=True;
Note: See TracChangeset for help on using the changeset viewer.