我在 Windows Vista 笔记本电脑上使用Free Pascal编译器 2.6.0 版在 Pascal 中编写了图灵机。在编译和测试结果后，我使用了“heaptrc”单元来检测一些内存泄漏。不幸的是，该程序找到了几个我无法修复的问题。
我已经通过 Google 和 Stack Overflow 寻找解决方案。在那里，我发现了我在程序中使用的“try finally”之类的结构。我将所有动态数组的大小重置为零以确保它们已被清理。这些措施解决了一些内存泄漏问题，但仍有八个未释放的内存块。
然后我在一个德国德尔福论坛上寻求帮助，在那里我得到了一些帮助，遗憾的是没有帮助。对于那些懂德语的人来说，它在Free Pascal 2.6.0 中。图灵机内存泄漏。
该程序的基本工作方式是通过读取 .txt 文件来创建和填充指令表。然后要求用户提供磁带的初始数据。在以下循环中，根据指令表更改数据，直到机器停止。
然后应该清理所有内容，但这似乎无法正常工作。如果我在调试器中运行程序，程序以退出代码“01”结束，根据文档，这意味着“无效的函数号尝试了无效的操作系统调用。”。但这也没有多大帮助。
如果我正确理解了“try finally”结构，则无论发生什么都应该调用并执行“Machine.Free”，因此应该正确清理所有内容。我通过反复试验学习了很多编程，所以我真的很想知道，为什么事情不能正常工作，而不仅仅是一个解决方案。
当然，如果有一些严重的设计缺陷，我愿意更改我的代码。这些是源代码文件。'heaptrc' 的输出在 'memory.txt' 中：
图灵帕斯
{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}
图灵头.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.
图灵表.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}
图灵表.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
内存.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