memory-leaks - FreePascalがコンパイルしたチューリングマシンのメモリリーク

Question

WindowsVistaラップトップでFreePascalコンパイラバージョン2.6.0を使用して、Pascalでチューリングマシンをプログラムしました。結果をコンパイルしてテストした後、「heaptrc」ユニットを使用してメモリリークを検出しました。残念ながら、プログラムはいくつかのものを見つけましたが、私はそれを修正できませんでした。

私はすでにGoogleとStackOverflowを介してソリューションを探していました。そこで、プログラムで使用した「tryfinally」のような構造を見つけました。念のため、すべての動的配列をゼロのサイズにリセットしました。これらはクリーンアップされています。これらの対策により、一部のメモリリークは解決されましたが、解放されていないメモリブロックが8つ残っていました。

それから私はドイツのDelphiフォーラムで助けを求めました、そこで私はいくつかの助けを得ました、それは悲しいことに助けにはなりませんでした。ドイツ語を理解している方のために、FreePascal2.6.0にあります。チューリングマシンのメモリリーク。

プログラムが機能する基本的な方法は、.txtファイルを読み取ることによって命令テーブルが作成され、入力されることです。次に、ユーザーはテープの初期データを求められます。次のループでは、マシンが停止するまで、命令テーブルに従ってデータが変更されます。

次に、すべてをクリーンアップする必要がありますが、これは正しく機能していないようです。プログラムをデバッガーで実行すると、プログラムは終了コード「01」で終了します。これは、ドキュメントによると、「無効な関数番号無効なオペレーティングシステムコールが試行されました」という意味です。しかし、それもあまり役に立ちませんでした。

「tryfinally」構造を正しく理解していれば、何が起こっても「Machine.Free」を呼び出して実行する必要があるため、すべてを正しくクリーンアップする必要があります。プログラミングは試行錯誤で学んだので、解決策だけでなく、なぜうまくいかないのかを知りたいと思います。

もちろん、重大な設計上の欠陥がある場合は、コードを変更する用意があります。これらはソースコードファイルです。'heaptrc'の出力は'memory.txt'にあります：

turing.pas

{turing.pas}
{Program to imitate a Turing machine, based on the principles by Alan Turing.}

program Turing;

{$mode objfpc}{$H+}

uses
  sysutils,  {Used for the conversion from Integer to String.}
  TuringHead, {Unit for the head instructions.}
  TuringTable; {Unit for the instruction table.}

type
{Declarations of self made types}
  TField = Array of Char;

{Class declarations}
  TMachine = class(TObject)
    private
      Tape: TField; {The tape, from which data is read or on which data is written.}
      TapeSize: Integer; {The length of the tape at the start of the machine.}
      Head: THead; {The head, which reads, writes and moves. Look in "turinghead.pas" to see, how it works.}
      InstructionTable: TInstructionTable; {The table, which contains the instructions for the machine. Look in "turingtable.pas" to see, how it works.}
      ConstantOutput: Boolean; {If its value is "True", there will be constant output.
                                It is adjustable for performance, because the machine is much slower when it has to output data all the time.}
      procedure GetSettings(); {Ask the user for different settings.}
      procedure GetInput(); {Read the input from the user.}
      procedure TapeResize(OldSize: Integer; Direction: Char); {Expand the tape and initialize a new element.}
      procedure TapeCopy(); {Copies the elements of the array to the right.}
      procedure Display(State: Char; ReadData: Char; WriteData: Char; MoveInstruction: Char; HeadPosition: Integer); {Display the machines current status.}
    public
      constructor Create(); {Prepare the machine.}
      procedure Run(); {Run the machine.}
      destructor Destroy(); Override;{Free all objects, the machine uses.}
    protected
    published
  end;

var
  Machine: TMachine;

procedure TMachine.GetSettings();
var
  OutputType: Char;
begin
  WriteLn('If you want constant output, please type "y", if not, please type "n"!');
  ReadLn(OutputType);
  case OutputType of
    'n': ConstantOutput := False;
    'y': ConstantOutput := True
  end;
  WriteLn('Please input the start tape length! It will expand automatically, if it overflows.');
  ReadLn(TapeSize);
  if TapeSize > 0 then {Test, if the input makes sense, to prevent errors.}
    SetLength(Tape, TapeSize)
  else
    begin
      WriteLn('Please input a length greater than zero!');
      GetSettings()
    end
end;

procedure TMachine.GetInput();
var
  UserInput: String;
  Data: Char;
  HeadPosition: Integer;
begin
  WriteLn('Please input the data for the tape!');
  SetLength(UserInput, TapeSize);
  ReadLn(UserInput);
  if UserInput[TapeSize] <> '' then
    begin
      HeadPosition := 0;
      while HeadPosition < TapeSize do
        begin
          Data := UserInput[HeadPosition + 1]; {The data is stored one place ahead of the current head position.}
          Head.WriteData(Tape, HeadPosition, Data);
          HeadPosition := Head.Move(HeadPosition, 'R')
        end;
      WriteLn('Thank you, these are the steps of the machine:')
    end
  else
    begin
      WriteLn('Please fill the whole tape with data!');
      GetInput()
    end
end;  

procedure TMachine.TapeResize(OldSize: Integer; Direction: Char);
var
  NewSize: Integer;
begin
  case Direction of
    'L': begin
      NewSize := OldSize + 1;
      SetLength(Tape, NewSize);
      TapeCopy(); {Copy the elements of the array, to make space for the new element.}
      Head.WriteData(Tape, Low(Tape), '0') {Initialize the new tape element with the empty data.}
    end;
    'R': begin
      NewSize := OldSize + 1;
      SetLength(Tape, NewSize);
      Head.WriteData(Tape, High(Tape), '0') {Initialize the new tape element with the empty data.}
    end
  end
end;

procedure TMachine.TapeCopy();
var
  Counter: Integer;
begin
  Counter := High(Tape);
  while Counter > 0 do
    begin
      Tape[Counter] := Tape[Counter - 1];
      Dec(Counter, 1)
    end
end;

procedure TMachine.Display(State: Char; ReadData: Char; WriteData: Char; MoveInstruction: Char; HeadPosition: Integer);
var
  DispHead: Integer;
begin
  DispHead := 0;
  while DispHead < Length(Tape) do {Write the data on the tape to the output.}
    begin
      Write(Tape[DispHead]);
      DispHead := Head.Move(DispHead, 'R');
    end;
  Write(' State: ' + State + ' Read: ' + ReadData + ' Write: ' + WriteData +
        ' Move: ' + MoveInstruction  + ' Head: ' + IntToStr(HeadPosition + 1)); {Constructed string to write information about the machine.}
  WriteLn('')
end;  

constructor TMachine.Create();
begin
  inherited;
  Head := THead.Create();
  InstructionTable := TInstructionTable.Create();
  GetSettings();
  GetInput()
end; {TMachine.Initialize}

procedure TMachine.Run();
var
  TapeData: Char; 
  WriteData: Char;
  StateRegister: Char; 
  MoveInstruction: Char; 
  HeadPosition: Integer; 
  Running: Boolean; 
begin
  if TapeSize > 1 then
    HeadPosition := (Length(Tape) div 2) - 1 {The head starts in the middle of the tape.}
  else
    HeadPosition := 0;
  StateRegister := 'A'; {This is the start register.}
  Running := True;

  while Running do
    begin
      {Get instructions for the machine.}
      TapeData := Head.ReadData(Tape, HeadPosition);
      WriteData := InstructionTable.GetData(StateRegister, TapeData, 'W');
      MoveInstruction := InstructionTable.GetData(StateRegister, TapeData, 'M');

      if ConstantOutput then
        Display(StateRegister, TapeData, WriteData, MoveInstruction, HeadPosition);

      Head.WriteData(Tape, HeadPosition, WriteData);

      case MoveInstruction of {Depending on the instructions, move the head.}
        'S': HeadPosition := Head.Move(HeadPosition, 'S');
        'L': HeadPosition := Head.Move(HeadPosition, 'L');
        'R': HeadPosition := Head.Move(HeadPosition, 'R')
      end;

      if HeadPosition > High(Tape) then
        TapeResize(Length(Tape), 'R');

      if HeadPosition < Low(Tape) then {If the head is farther to the left, than the tape is long, create a new field on the tape.}
        begin
          TapeResize(Length(Tape), 'L'); 
          HeadPosition := 0
        end;

      {Get the next state of the machine.}
      StateRegister := InstructionTable.GetData(StateRegister, TapeData, 'N');

      if StateRegister = 'H' then {This is the halting register.}
        begin
          Display(StateRegister, TapeData, WriteData, MoveInstruction, HeadPosition);
          Running := Head.Halt()
        end
    end
end; {TMachine.Run}

destructor TMachine.Destroy();
begin
  Head.Free;
  InstructionTable.Free;
  SetLength(Tape, 0);
  WriteLn('The turing machine stopped. You can end the program by pressing enter.');
  inherited
end; {TMachine.Stop}


{Implementation of the main program.}
begin
  Machine := TMachine.Create();
  try
    Machine.Run()
  finally
    Machine.Free
  end;
  ReadLn()
end. {Turing}

turinghead.pas

{turinghead.pas}
{Unit for the head of the turing machine.}

unit TuringHead;

{$mode objfpc}{$H+}

interface

type
  THead = class(TObject)
    private
      function Stay(HeadPos: Integer): Integer; {Head does not move.}
      function MoveLeft(HeadPos: Integer): Integer; {Head moves leftwards.}
      function MoveRight(HeadPos: Integer): Integer; {Head moves rightwards.}
    public
      function Move(HeadPos: Integer; Direction: Char): Integer; {Public function, which calls 'Stay' or 'MoveLeft/Right'.}
      function ReadData(Tape: Array of Char; HeadPos: Integer): Char; {Reads data from the tape.}
      procedure WriteData(var Tape: Array of Char; HeadPos: Integer; Data: Char); {Writes data onto the tape.}
      function Halt(): Boolean; {Commands the head to stop moving.}
    protected
    published
  end;

implementation

function THead.Move(HeadPos: Integer; Direction: Char): Integer;
var
  NextPos: Integer;
begin
  case Direction of {Used this way, so only one function has to be public, not three.}
    'S': NextPos := Stay(HeadPos);
    'L': NextPos := MoveLeft(HeadPos);
    'R': NextPos := MoveRight(HeadPos)
  end;
  Move := NextPos
end; {THead.Move}

function THead.ReadData(Tape: Array of Char; HeadPos: Integer): Char;
var
  Data: Char;
begin
  Data := Tape[HeadPos];
  ReadData := Data
end; {THead.ReadData}

procedure THead.WriteData(var Tape: Array of Char; HeadPos: Integer; Data: Char);
begin
  Tape[HeadPos] := Data
end; {THead.WriteData}

function THead.Stay(HeadPos: Integer): Integer;
var
  NextPosition: Integer;
begin
  NextPosition := HeadPos;
  Stay := NextPosition
end; {THead.Stay}

function THead.MoveLeft(HeadPos: Integer): Integer;
var
  NextPosition: Integer;
begin
  NextPosition := HeadPos - 1;
  MoveLeft := NextPosition
end; {THead.MovetLeft}

function THead.MoveRight(HeadPos: Integer): Integer;
var
  NextPosition: Integer;
begin
  NextPosition := HeadPos + 1;
  MoveRight := NextPosition
end; {THead.MoveRight}

function THead.Halt(): Boolean;
begin
  Halt := False
end; {THead.Halt}

begin
end.

turingtable.pas

{turingtable.pas}
{Unit for creating and accessing the instruction table.}

unit TuringTable;

{$mode objfpc}{$H+}

interface

const
  TupelLength = 5; {The amount of characters, each tupel has.}

type
{Declarations of self made types}
  TTextFile = TextFile;
  TDataString = Array of String[TupelLength]; {Every tupel has its own data string.}
  TDataTable = record {The type of the record, which is used to look up the instructions for the machine.}
      State: Array of Char; {The current state of the machine.}
      Read:  Array of Char; {The read data.}
      Write: Array of Char; {The data, which has to be written onto the tape.}
      Move:  Array of Char; {The movement instruction for the head.}
      Next:  Array of Char  {The next state of the machine.}
    end;

{Class declarations}
  TInstructionTable = class(TObject)
    private
      TupelNumber: Word; {The number of seperate tupels, which are defined in the text file.}
      DataString: TDataString; {The strings, that have all the tupels.}
      DataTable: TDataTable;
      procedure FileRead();
      procedure ArrayResize(Size: Word); {Resizes all arrays, so they are only as big, as they have to be.}
      procedure TableFill(); {Fills the data table with data from the data string.}
      function GetWrite(CurrentState: Char; ReadData: Char): Char; {Functions, which return the wanted instruction from the table.}
      function GetMove(CurrentState: Char; ReadData: Char): Char;
      function GetNext(CurrentState: Char; ReadData: Char): Char;
    public
      constructor Create(); {Creates the data table, so it can be used.}
      function GetData(CurrentState: Char; ReadData: Char; DataType: Char): Char; {Public function to get instructions.}
      destructor Destroy(); Override;
    protected
    published
  end;

implementation

procedure TInstructionTable.FileRead();
const
  FileName = 'turingtable.txt'; {The text file, that contains the instructions.}
var
  Text: String[TupelLength]; {The read text, which is just one unorganised string.}
  CurrentTupel: Word; {Keeps track of the tupels.}
  DataFile: TTextFile;
begin
  SetLength(DataString, 256); {Make the array pretty big, so it gives enough space.}
  CurrentTupel := 0;
  Assign(DataFile, FileName); {Open the file.}
  Reset(DataFile);
  while not eof(DataFile) do {As long, as the procedure did not reach the end of the text file, it shall proceed.}
    begin
      ReadLn(DataFile, Text);
      if Text[1] <> '/' then {If the line starts with an '/', it is a comment and thus not necessary for the program.}
        begin
          DataString[CurrentTupel] := Text; {Fill the data string.}
          inc(CurrentTupel, 1)
        end
    end;
  ArrayResize(CurrentTupel);
  TupelNumber := CurrentTupel; {This is the maximum amount of tupels.}
  Close(DataFile)
end; {TinstructionTable.FileRead}

procedure TInstructionTable.ArrayResize(Size: Word);
begin
  SetLength(DataString, Size);
  SetLength(DataTable.State, Size);
  SetLength(DataTable.Read, Size);
  SetLength(DataTable.Write, Size);
  SetLength(DataTable.Move, Size);
  SetLength(DataTable.Next, Size)
end; {TInstructionTable.ArrayResize}

procedure TInstructionTable.TableFill();
var
  Position: Word;
  CurrentTupel: Word;
begin
  Position := 1;
  CurrentTupel := 0;
  while CurrentTupel <= TupelNumber do {Fill the record for each tupel.}
    begin
      while Position <= TupelLength do {Each tupel has a certain instruction at the same place, so the record is filled in a certain way.}
        begin
          case Position of
            1: DataTable.State[CurrentTupel] := DataString[CurrentTupel][Position];
            2: DataTable.Read[CurrentTupel]  := DataString[CurrentTupel][Position];
            3: DataTable.Write[CurrentTupel] := DataString[CurrentTupel][Position];
            4: DataTable.Move[CurrentTupel]  := DataString[CurrentTupel][Position];
            5: DataTable.Next[CurrentTupel]  := DataString[CurrentTupel][Position]
          end;
          inc(Position, 1)
        end;
        Position := 1;
        inc(CurrentTupel, 1)
    end
end; {TInstructionTable.TableFill}

function TInstructionTable.GetWrite(CurrentState: Char; ReadData: Char): Char;
var
  Write: Char;
  EntryFound: Boolean;
  CurrentTupel: Integer;
begin
  EntryFound := false;
  CurrentTupel := 0;
  while not EntryFound do
    if (DataTable.State[CurrentTupel] = CurrentState) and (DataTable.Read[CurrentTupel] = ReadData) then {Tests, if the data pair exists in the record.}
      EntryFound := True
    else
      inc(CurrentTupel, 1);
  Write := DataTable.Write[CurrentTupel];
  GetWrite := Write
end; {TInstructionTable.GetWrite}

function TInstructionTable.GetMove(CurrentState: Char; ReadData: Char): Char;
var
  Move: Char;
  EntryFound: Boolean;
  CurrentTupel: Integer;
begin
  EntryFound := false;
  CurrentTupel := 0;
  while not EntryFound do
    if (DataTable.State[CurrentTupel] = CurrentState) and (DataTable.Read[CurrentTupel] = ReadData) then {Tests, if the data pair exists in the record.}
      EntryFound := True
    else
      inc(CurrentTupel, 1);
  Move := DataTable.Move[CurrentTupel];
  GetMove := Move
end; {TInstructionTable.GetMove}

function TInstructionTable.GetNext(CurrentState: Char; ReadData: Char): Char;
var
  Next: Char;
  EntryFound: Boolean;
  CurrentTupel: Integer;
begin
  EntryFound := false;
  CurrentTupel := 0;
  while not EntryFound do
    if (DataTable.State[CurrentTupel] = CurrentState) and (DataTable.Read[CurrentTupel] = ReadData) then {Tests, if the data pair exists in the record.}
      EntryFound := True
    else
      inc(CurrentTupel, 1);
  Next := DataTable.Next[CurrentTupel];
  GetNext := Next
end; {TInstructionTable.GetNext}

constructor TInstructionTable.Create();
begin
  inherited;
  FileRead();
  TableFill()
end; {TInstructionTable.Initialize}

function TInstructionTable.GetData(CurrentState: Char; ReadData: Char; DataType: Char): Char;
var
  Data: Char;
begin
  case DataType of {Used this way, so only one public function exists, instead of three.}
    'W': Data := GetWrite(CurrentState, ReadData);
    'M': Data := GetMove(CurrentState, ReadData);
    'N': Data := GetNext(CurrentState, ReadData)
  end;
  GetData := Data
end; {TInstructionTable.GetData}

destructor TInstructionTable.Destroy();
begin
  ArrayResize(0);
  inherited
end;

begin
end. {TuringTable}

turingtable.txt

/This is the table for the turing machine.
/Here you can define the instructions for the machine.
/Please use the given format.
/The start state is 'A'. 
/Use 'S' for staying, 'L' for moving the head leftwards and 'R' for moving the head rightwards.
/'H' is used to stop the machine.
/The head starts in the middle of the tape.
/If the array is expanded, it is filled with '0'.
/Lines are commented out when they begin with '/'.
/State Read Write Move Next

/Busy beavers taken from en.wikipedia.org

/2-state, 2-symbol busy beaver
/A01LB
/A11RB
/B01RA
/B11LH

/3-state, 2-symbol busy beaver
/A01LB
/A11RC
/B01RA
/B11LB
/C01RB
/C11SH

/4-state, 2-symbol busy beaver
A01LB
A11RB
B01RA
B10RC
C01LH
C11RD
D01LD
D10LA

/5-state, 2-symbol best contender busy beaver
/A01LB
/A11RC
/B01LC
/B11LB
/C01LD
/C10RE
/D01RA
/D11RD
/E01LH
/E10RA

/6-state, 2-symbol best contender busy beaver
/A01LB
/A11RE
/B01LC
/B11LF
/C01RD
/C10LB
/D01LE
/D10RC
/E01RA
/E10LD
/F01RH
/F11LC

memory.txt

C:\Programming_Software\FreePascal\2.6.0\projects\Turing_Machine\memory\turing.exe 
Marked memory at $000A5200 invalid
Wrong signature $D4DF2FA1 instead of A76E4766
  $0040F85B
  $0040F917
  $0041550D  TINSTRUCTIONTABLE__ARRAYRESIZE,  line 76 of turingtable.pas
  $004159FD  TINSTRUCTIONTABLE__DESTROY,  line 180 of turingtable.pas
  $00407162
  $00407162
  $0040C7B1
Heap dump by heaptrc unit
714 memory blocks allocated : 14207/18256
706 memory blocks freed     : 14061/18080
8 unfreed memory blocks : 146
True heap size : 458752 (144 used in System startup)
True free heap : 457824
Should be : 457920
Call trace for block $000A53E0 size 22
  $004018CF  TMACHINE__TAPERESIZE,  line 104 of turing.pas
  $00401E81  TMACHINE__RUN,  line 181 of turing.pas
  $0040201D  main,  line 216 of turing.pas
  $0040C7B1
Marked memory at $000A5380 invalid
Wrong signature $B3102445 instead of 3D0C752B
  $004106C7
  $0040F85B
  $0040F917
  $0041550D  TINSTRUCTIONTABLE__ARRAYRESIZE,  line 76 of turingtable.pas
  $004159FD  TINSTRUCTIONTABLE__DESTROY,  line 180 of turingtable.pas
  $00407162
  $00407162
  $0040C7B1
Marked memory at $000A5320 invalid
Wrong signature $FECB68AA instead of D626F67E
  $004106C7
  $0040F85B
  $0040F917
  $0041550D  TINSTRUCTIONTABLE__ARRAYRESIZE,  line 76 of turingtable.pas
  $004159FD  TINSTRUCTIONTABLE__DESTROY,  line 180 of turingtable.pas
  $00407162
  $00407162
  $0040C7B1
Marked memory at $000A52C0 invalid
Wrong signature $E738AA53 instead of AFAF3597
  $004106C7
  $0040F85B
  $0040F917
  $0041550D  TINSTRUCTIONTABLE__ARRAYRESIZE,  line 76 of turingtable.pas
  $004159FD  TINSTRUCTIONTABLE__DESTROY,  line 180 of turingtable.pas
  $00407162
  $00407162
  $0040C7B1
Marked memory at $000A5260 invalid
Wrong signature $CD2CED58 instead of FC317DEE
  $004106C7
  $0040F85B
  $0040F917
  $0041550D  TINSTRUCTIONTABLE__ARRAYRESIZE,  line 76 of turingtable.pas
  $004159FD  TINSTRUCTIONTABLE__DESTROY,  line 180 of turingtable.pas
  $00407162
  $00407162
  $0040C7B1
Marked memory at $000A5200 invalid
Wrong signature $D4DF2FA1 instead of A76E4766
  $004106C7
  $0040F85B
  $0040F917
  $0041550D  TINSTRUCTIONTABLE__ARRAYRESIZE,  line 76 of turingtable.pas
  $004159FD  TINSTRUCTIONTABLE__DESTROY,  line 180 of turingtable.pas
  $00407162
  $00407162
  $0040C7B1
Call trace for block $000AC3C8 size 32
  $00401C59  TMACHINE__CREATE,  line 141 of turing.pas
  $00401FF4  main,  line 214 of turing.pas
  $0040C7B1
  $00610068
  $00650072
  $005C0064
  $00690057
  $0064006E
Call trace for block $000A51A0 size 24
  $00401FF4
  $0040C7B1
  $0040C7B1

score 2 · Accepted Answer

コメントで述べたように、あなたの最初の問題は「無効なメモリ」です。メモリの安全性は、プログラムが正しく機能している場合にのみ発生します。さまざまな種類のチェック（範囲/オーバーフロー）を調べます。

範囲チェック（-Cr）を使用してすばやくコンパイルすると、次の出力が得られます。

An unhandled exception occurred at $00418609:
ERangeError: Range check error
   $00418609  TINSTRUCTIONTABLE__TABLEFILL,  line 95 of turingtable.pas
   $00418B56  TINSTRUCTIONTABLE__CREATE,  line 163 of turingtable.pas
   $00401CFA  TMACHINE__CREATE,  line 140 of turing.pas
   $004020AD  main,  line 211 of turing.pas

私の推測では、filereadはデータ文字列を初期化しますが、データテーブルは初期化しません。データテーブルにはいくつかの動的配列も含まれています。

すべてが失敗した場合は、Valgrindを使用できますが、このサイズと複雑さのプログラムでは、おそらくやり過ぎです。

この質問から学ぶべき教訓：エラー/例外が発生した場合、コードの通常のフローが中断され、コード（メモリの解放を含む）が実行されず、メモリデバッグツールに表示される可能性があります。Pascalの長所の1つは、（オプションの）ランタイムチェックです。それらを使用してください。

memory-leaks - FreePascalがコンパイルしたチューリングマシンのメモリリーク

turing.pas

turinghead.pas

turingtable.pas

turingtable.txt

memory.txt

1 に答える 1

Related

Reference