Memory leak in a Turing machine, compiled by Free Pascal [closed]
-
07-07-2021 - |
Question
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
La solution
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.