Memory leak in a Turing machine, compiled by Free Pascal [closed]

Question

This question is unlikely to help any future visitors; it is only relevant to a small geographic area, a specific moment in time, or an extraordinarily narrow situation that is not generally applicable to the worldwide audience of the internet. For help making this question more broadly applicable, visit the help center.

Closed 8 years ago.

I programmed a Turing machine in Pascal using the Free Pascal compiler version 2.6.0 on a Windows Vista laptop. After compiling and testing the results, I used the 'heaptrc' unit to detect some memory leaks. Unfortunately, the program found several ones, which I was not able to fix.

I already looked for solutions via Google and Stack Overflow. There I found constructs like 'try finally' which I used in the program. I reset all dynamic arrays to size of zero to be sure, they are cleaned up. These measures solved some memory leaks, but eight unfreed memory blocks remained.

Then I asked for help in a German Delphi forum, where I got some help, which sadly did not help. For those of you, who understand German, it is in Free Pascal 2.6.0. Memory Leak in Turingmaschine.

The basic way the program works, is, that the instruction table is created and filled by reading a .txt file. Then the user is asked for the initial data of the tape. In the following loop, the data is changed according to the instruction table until the machine is halted.

Then everything should be cleaned up, but this does not seem to work correctly. If I run the program in a debugger, the program ends with the exitcode '01', which, according to documentation, means 'Invalid function number An invalid operating system call was attempted.'. But that did not help very much either.

If I understand the 'try finally' structure correctly, 'Machine.Free' should be called and executed no matter what happens, so everything should be cleaned up correctly. I learned programming pretty much by trial and error, so I would really like to know, why things do not work correctly, and not just a solution.

Of course I am willing to change my code, if there is some serious design flaw. These are the source code files. The output of 'heaptrc' is in '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

Answer 1

As said in the comment, your first problem is the "invalid memory". Memory safety only comes when the program is working correctly. Look into the various kinds of checking (range/overflow).

I quickly compiled with range checks (-Cr) and I get this output:

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

My guess is that while fileread initializes the datastring, you don't initialize the datatable, which also holds several dynamic arrays.

If everything fails, you can use Valgrind, but for programs of this size and complexity that is probably overkill.

The lesson to be learned from this question: If an error/exception happens, the normal flow of code is interrupted, and code (including freeing of memory) might not be done and turn up in memory debugging tools. One of the Pascal virtues are the (optional) runtime checks. Use them.