Ошибка в программе из под компилятора FPC - Free Pascal
Формулировка задачи:
Люди помогите с кодом. При компиляции в FPC, программа завершает работу с ошибкой Runtime error 216, при компиляции кода в BP7 программа работает без ошибок. Ошибка в стр.158 процедуре pr_DirectFusion.
Листинг программы
- program lab3;
- uses Crt;
- const
- chis=['1'..'2'];{Массив для работы меню}
- type
- PInf = ^TInf;
- TInf = record {Запись для элемента очереди}
- num:Integer; {Число }
- next:PInf; {Указатель на следующий элемент очереди}
- end;
- var
- c,m:Longint; {Количество операций сравнения и пересылок}
- key:char; {Переменная для работы меню}
- keys,kn:integer;
- ftext:text; {Переменная для работы с текстовым файлом}
- txt_filename:string[9]; {Переменная для определения имени файла}
- function IsQueueEmpty(qHead, qTail:PInf):Boolean;{Функция проверки очереди на пустоту}
- begin
- IsQueueEmpty:=qHead=nil;
- end;
- procedure SetQueueNext(var qHead, qTail:PInf; next:PInf);{Процедура устанавливает следующий элемент очереди}
- begin
- if IsQueueEmpty(qHead, qTail) then begin
- qHead:=next
- end
- else begin
- qTail^.next:=next;
- end;
- qTail:=next;
- end;
- procedure AddQueueNext(var qHead, qTail:PInf; num:Integer);{Процедура добавления нового элемента в очередь}
- var
- p:PInf;
- begin
- New(p);
- p^.num:=num;
- p^.next:=nil;
- SetQueueNext(qHead, qTail, p);
- end;
- procedure EmptyQueue(var qHead, qTail:PInf);{Процедура очистки очереди}
- begin
- qHead:=nil;
- qTail:=nil;
- end;
- procedure RandomQueue(var qHead, qTail:PInf);{Процедура заполнения очереди случайными числами от 0 до 99}
- var
- i:Integer;
- begin
- Randomize;
- for i:=1 to kn do
- AddQueueNext(qHead, qTail, Random(100));
- end;
- procedure pr_DirectFusion(var qHead, qTail:PInf); {Процедура сортировки очереди методом прямого слияния}
- var
- aHead:array[0..1] of PInf; {Указатели на начала рабочих очередей }
- aTail:array[0..1] of PInf; {Указатели на концы рабочих очередей }
- cHead:array[0..1] of PInf; {Указатели на начала очередей для слияния }
- cTail:array[0..1] of PInf; {Указатели на концы очередей для слияния }
- qr:array[0..1] of Integer; {Размеры серий для рабочих очередей }
- i,k,n,p:Integer;
- p1:PInf;
- begin
- c:=0;
- m:=0;
- for i:=0 to 1 do
- EmptyQueue(aHead[i], aTail[i]);
- n:=0;
- k:=0;
- p1:=qHead;
- while p1<>nil do begin {Делаем расщепление очереди на 2 очереди}
- SetQueueNext(aHead[k], aTail[k], p1);
- Inc(m);
- Inc(n);
- k:=1-k; {Меняем очередь на другую }
- p1:=p1^.next;
- end;
- for k:=0 to 1 do
- aTail[k]^.next:= nil;
- p:=1; {Начинаем основной алгоритм сортировки }
- while p<n do begin
- for k:=0 to 1 do
- EmptyQueue(cHead[k], cTail[k]);
- i:=0;
- {Пока в рабочих очередях есть элементы }
- while (aHead[0]<>nil) or (aHead[1]<>nil) do begin
- for k:=0 to 1 do begin
- qr[k]:=0;
- if aHead[k] <> nil then
- qr[k]:=p;
- end;
- {Реализовываем алгоритм слияния }
- while (qr[0] > 0) and (qr[1] > 0) do begin
- case aHead[0]^.num < aHead[1]^.num of
- True:k:=0;
- False:k:=1;
- end;
- Inc(c);
- SetQueueNext(cHead[i], cTail[i], aHead[k]);
- Inc(m);
- {Перемещаем указатель начала рабочей очереди вперед }
- aHead[k]:=aHead[k]^.next;
- if aHead[k] <> nil then
- Dec(qr[k])
- else
- qr[k]:=0;
- end;
- k:=-1;
- if qr[0] > 0 then {Если в рабочей очереди 0 еще остались элементы }
- k:=0
- else if qr[1] > 0 then {Если в рабочей очереди 0 еще остались элементы }
- k:=1;
- if k in [0,1] then
- while (qr[k]>0) and (aHead[k]<>nil) do begin
- SetQueueNext(cHead[i],cTail[i],aHead[k]);
- Inc(m);
- aHead[k]:=aHead[k]^.next;
- Dec(qr[k]);
- end;
- i:=1-i;
- end;
- for k:=0 to 1 do begin
- cTail[k]^.next:=nil;
- end;
- for k:=0 to 1 do begin
- aHead[k]:=cHead[k]; {Получаем новые рабочие очереди }
- end;
- p:=2*p; {Увеличиваем размер серии }
- end;
- qHead:=cHead[0];
- qTail:=cTail[0];
- end;
- { Возвращает из числа num цифру с номером digitNo, при условии, что
- в числе всего digitsNumber цифр }
- function Digit(num, digitsNumber, digitNo: Integer): Integer;
- var
- i:Integer;
- s:String;
- begin
- Str(num,s);
- while Length(s) < digitsNumber do
- s:='0'+s;
- Digit:= Ord(s[digitNo]) - Ord('0');
- end;
- procedure ConcatQueues(var q1Head, q1Tail: PInf; q2Head, q2Tail: PInf);{Процедура Объединения двух очередей}
- begin
- if IsQueueEmpty(q2Head, q2Tail) then
- Exit;
- if IsQueueEmpty(q1Head, q1Tail) then begin
- q1Head := q2Head;
- q1Tail := q2Tail;
- end
- else begin
- q1Tail^.next := q2Head;
- q1Tail := q2Tail;
- end;
- end;
- procedure pr_DigitalSorting(var qHead, qTail:PInf);{Процедура цифровой сортировки очереди}
- const
- l= 2; {Количество байт для сравнения}
- mm= 10; {Количество очередей}
- var
- qmHead: array[0..mm - 1] of PInf; {Головы очередей}
- qmTail: array[0..mm - 1] of PInf; {Хвосты очередей}
- i,d,j:Integer;
- p,pTmp:PInf;
- begin
- c:=0;
- m:=0;
- for j:=l downto 1 do begin
- for i:=0 to mm-1 do {Делаем очереди пустыми}
- EmptyQueue(qmHead[i], qmTail[i]);
- p:=qHead;
- while p<>nil do begin {Заполняем очереди}
- d:=Digit(p^.num, l, j);
- pTmp:=p;
- p:=p^.next;
- SetQueueNext(qmHead[d], qmTail[d], pTmp);
- qmTail[d]^.next:=nil;
- Inc(m);
- end;
- EmptyQueue(qHead, qTail);
- for i:=0 to mm-1 do begin { Объединяем все очереди в одну }
- ConcatQueues(qHead, qTail, qmHead[i], qmTail[i]);
- Inc(m);
- end;
- end;
- end;
- procedure PrintQueue(qHead, qTail:PInf);{Процедура вывода очереди на экран и в файл}
- var
- p:PInf;
- begin
- p:=qHead;
- while p<>nil do begin
- Write(p^.num,' ');
- write(ftext, p^.num,' ');
- p:=p^.next;
- end;
- Writeln;
- writeln(ftext);
- end;
- procedure PrintInf;{Процедура вывода на экран количества операций сравнения и пересылок}
- begin
- Writeln('C = ', c, ', M = ', m);
- writeln(ftext, 'C = ', c, ', M = ', m);
- end;
- procedure Print(var qHead, qTail:PInf; s:String; keys:integer);{Процедура вывода на экран информации об очереди}
- begin
- Writeln(s,':');
- writeln(ftext, s,':');
- PrintQueue(qHead, qTail);
- Writeln;
- writeln(ftext);
- case keys of {Запуск процедуры сортировки масива взависимости от выбора в меню}
- 1:pr_DirectFusion(qHead, qTail);
- 2:pr_DigitalSorting(qHead, qTail);
- end;
- Writeln('Последовательность после сортировки:');
- writeln(ftext,'Последовательность после сортировки:');
- PrintQueue(qHead, qTail);
- Writeln;
- writeln(ftext);
- PrintInf;
- Writeln('Для продолжения нажмите любую клавишу...');
- ReadKey;
- end;
- var
- qHead,qTail:PInf; {Указатели на начало и конец очереди }
- begin
- ClrScr;
- Writeln('Меню выбора метода сортировки последовательности целых чисел:');
- Writeln('1. Метод прямого слияния');
- Writeln('2. Методом цифровой сортировки');
- Write('Нажмите клавишу 1, 2');
- repeat
- key:=readkey;
- until (key in chis);
- keys:=integer(key)-48;
- str(keys:1,txt_filename);
- txt_filename:='lab3' + txt_filename + '.txt';
- assign(ftext, txt_filename); {Создаем текстовый файл lab1+метод.txt}
- {$I-}Reset(ftext);{$I+} {Ловим ошибку при отсутствии файла}
- if IOResult = 2 then begin
- Rewrite(ftext);{Если нет файла, создаем}
- end
- else begin
- Append(ftext);
- end;
- case keys of
- 1:writeln(ftext, 'Метод прямого слияния');
- 2:writeln(ftext, 'Методом цифровой сортировки');
- end;
- ClrScr;
- Write('Введите количество элементов в последовательности:');
- Readln(kn);
- writeln(ftext, 'количество элементов в последовательности - ',kn);
- Writeln;
- RandomQueue(qHead, qTail);{Генерация элементов}
- Print(qHead, qTail, 'Случайная последовательность',keys);
- Writeln;
- writeln(ftext);
- Print(qHead, qTail, 'Упорядоченная последовательность',keys);
- close(ftext);
- Writeln('Для выхода из программы нажмите любую клавишу...');
- ReadKey;
- end.
Решение задачи: «Ошибка в программе из под компилятора FPC»
textual
Листинг программы
- for k := 0 to 1 do
- cTail[k]^.next := nil;
- for k := 0 to 1 do
- aHead[k] := cHead[k];
- p := 2 * p;
- end;
Объяснение кода листинга программы
В данном коде выполняются следующие действия:
- Устанавливается значение переменной
p
равным 2 умножить на значение переменнойp
(возможно, это некорректная операция, так как переменнаяp
еще не инициализирована). - Запускается цикл от 0 до 1 с помощью выражения
for k := 0 to 1 do
. - Внутри цикла выполняется следующее действие:
cTail[k]^.next := nil;
. Это выражение обращается к элементу массиваcTail
по индексуk
и устанавливает значение поляnext
этого элемента вnil
. Это может использоваться для обхода списка. - Завершается первый цикл.
- Запускается второй цикл от 0 до 1 с помощью выражения
for k := 0 to 1 do
. - Внутри цикла выполняется следующее действие:
aHead[k] := cHead[k];
. Это выражение присваивает значение переменнойcHead
по индексуk
переменнойaHead
по тому же индексу. Это может использоваться для копирования списка. - Завершается второй цикл.
- Выполняется операция умножения
p := 2 * p;
. Возможно, это некорректная операция, так как переменнаяp
еще не инициализирована. - Завершается основной блок кода.
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д