Ошибка в программе из под компилятора FPC - Free Pascal

Узнай цену своей работы

Формулировка задачи:

Люди помогите с кодом. При компиляции в FPC, программа завершает работу с ошибкой Runtime error 216, при компиляции кода в BP7 программа работает без ошибок. Ошибка в стр.158 процедуре pr_DirectFusion.
Листинг программы
  1. program lab3;
  2. uses Crt;
  3. const
  4. chis=['1'..'2'];{Массив для работы меню}
  5. type
  6. PInf = ^TInf;
  7. TInf = record {Запись для элемента очереди}
  8. num:Integer; {Число }
  9. next:PInf; {Указатель на следующий элемент очереди}
  10. end;
  11. var
  12. c,m:Longint; {Количество операций сравнения и пересылок}
  13. key:char; {Переменная для работы меню}
  14. keys,kn:integer;
  15. ftext:text; {Переменная для работы с текстовым файлом}
  16. txt_filename:string[9]; {Переменная для определения имени файла}
  17.  
  18. function IsQueueEmpty(qHead, qTail:PInf):Boolean;{Функция проверки очереди на пустоту}
  19. begin
  20. IsQueueEmpty:=qHead=nil;
  21. end;
  22.  
  23. procedure SetQueueNext(var qHead, qTail:PInf; next:PInf);{Процедура устанавливает следующий элемент очереди}
  24. begin
  25. if IsQueueEmpty(qHead, qTail) then begin
  26. qHead:=next
  27. end
  28. else begin
  29. qTail^.next:=next;
  30. end;
  31. qTail:=next;
  32. end;
  33.  
  34. procedure AddQueueNext(var qHead, qTail:PInf; num:Integer);{Процедура добавления нового элемента в очередь}
  35. var
  36. p:PInf;
  37. begin
  38. New(p);
  39. p^.num:=num;
  40. p^.next:=nil;
  41. SetQueueNext(qHead, qTail, p);
  42. end;
  43.  
  44. procedure EmptyQueue(var qHead, qTail:PInf);{Процедура очистки очереди}
  45. begin
  46. qHead:=nil;
  47. qTail:=nil;
  48. end;
  49.  
  50. procedure RandomQueue(var qHead, qTail:PInf);{Процедура заполнения очереди случайными числами от 0 до 99}
  51. var
  52. i:Integer;
  53. begin
  54. Randomize;
  55. for i:=1 to kn do
  56. AddQueueNext(qHead, qTail, Random(100));
  57. end;
  58.  
  59. procedure pr_DirectFusion(var qHead, qTail:PInf); {Процедура сортировки очереди методом прямого слияния}
  60. var
  61. aHead:array[0..1] of PInf; {Указатели на начала рабочих очередей }
  62. aTail:array[0..1] of PInf; {Указатели на концы рабочих очередей }
  63. cHead:array[0..1] of PInf; {Указатели на начала очередей для слияния }
  64. cTail:array[0..1] of PInf; {Указатели на концы очередей для слияния }
  65. qr:array[0..1] of Integer; {Размеры серий для рабочих очередей }
  66. i,k,n,p:Integer;
  67. p1:PInf;
  68.  
  69. begin
  70. c:=0;
  71. m:=0;
  72.  
  73. for i:=0 to 1 do
  74. EmptyQueue(aHead[i], aTail[i]);
  75. n:=0;
  76. k:=0;
  77. p1:=qHead;
  78. while p1<>nil do begin {Делаем расщепление очереди на 2 очереди}
  79. SetQueueNext(aHead[k], aTail[k], p1);
  80. Inc(m);
  81. Inc(n);
  82. k:=1-k; {Меняем очередь на другую }
  83. p1:=p1^.next;
  84. end;
  85. for k:=0 to 1 do
  86. aTail[k]^.next:= nil;
  87. p:=1; {Начинаем основной алгоритм сортировки }
  88.  
  89. while p<n do begin
  90. for k:=0 to 1 do
  91. EmptyQueue(cHead[k], cTail[k]);
  92. i:=0;
  93. {Пока в рабочих очередях есть элементы }
  94. while (aHead[0]<>nil) or (aHead[1]<>nil) do begin
  95. for k:=0 to 1 do begin
  96. qr[k]:=0;
  97. if aHead[k] <> nil then
  98. qr[k]:=p;
  99. end;
  100. {Реализовываем алгоритм слияния }
  101. while (qr[0] > 0) and (qr[1] > 0) do begin
  102. case aHead[0]^.num < aHead[1]^.num of
  103. True:k:=0;
  104. False:k:=1;
  105. end;
  106. Inc(c);
  107. SetQueueNext(cHead[i], cTail[i], aHead[k]);
  108. Inc(m);
  109.  
  110. {Перемещаем указатель начала рабочей очереди вперед }
  111. aHead[k]:=aHead[k]^.next;
  112. if aHead[k] <> nil then
  113. Dec(qr[k])
  114. else
  115. qr[k]:=0;
  116. end;
  117. k:=-1;
  118. if qr[0] > 0 then {Если в рабочей очереди 0 еще остались элементы }
  119. k:=0
  120. else if qr[1] > 0 then {Если в рабочей очереди 0 еще остались элементы }
  121. k:=1;
  122. if k in [0,1] then
  123. while (qr[k]>0) and (aHead[k]<>nil) do begin
  124. SetQueueNext(cHead[i],cTail[i],aHead[k]);
  125. Inc(m);
  126. aHead[k]:=aHead[k]^.next;
  127. Dec(qr[k]);
  128. end;
  129. i:=1-i;
  130. end;
  131.  
  132. for k:=0 to 1 do begin
  133. cTail[k]^.next:=nil;
  134. end;
  135.  
  136. for k:=0 to 1 do begin
  137. aHead[k]:=cHead[k]; {Получаем новые рабочие очереди }
  138. end;
  139. p:=2*p; {Увеличиваем размер серии }
  140. end;
  141. qHead:=cHead[0];
  142. qTail:=cTail[0];
  143. end;
  144.  
  145. { Возвращает из числа num цифру с номером digitNo, при условии, что
  146. в числе всего digitsNumber цифр }
  147. function Digit(num, digitsNumber, digitNo: Integer): Integer;
  148. var
  149. i:Integer;
  150. s:String;
  151. begin
  152. Str(num,s);
  153. while Length(s) < digitsNumber do
  154. s:='0'+s;
  155. Digit:= Ord(s[digitNo]) - Ord('0');
  156. end;
  157.  
  158. procedure ConcatQueues(var q1Head, q1Tail: PInf; q2Head, q2Tail: PInf);{Процедура Объединения двух очередей}
  159. begin
  160. if IsQueueEmpty(q2Head, q2Tail) then
  161. Exit;
  162. if IsQueueEmpty(q1Head, q1Tail) then begin
  163. q1Head := q2Head;
  164. q1Tail := q2Tail;
  165. end
  166. else begin
  167. q1Tail^.next := q2Head;
  168. q1Tail := q2Tail;
  169. end;
  170. end;
  171.  
  172. procedure pr_DigitalSorting(var qHead, qTail:PInf);{Процедура цифровой сортировки очереди}
  173. const
  174. l= 2; {Количество байт для сравнения}
  175. mm= 10; {Количество очередей}
  176. var
  177. qmHead: array[0..mm - 1] of PInf; {Головы очередей}
  178. qmTail: array[0..mm - 1] of PInf; {Хвосты очередей}
  179. i,d,j:Integer;
  180. p,pTmp:PInf;
  181. begin
  182. c:=0;
  183. m:=0;
  184. for j:=l downto 1 do begin
  185. for i:=0 to mm-1 do {Делаем очереди пустыми}
  186. EmptyQueue(qmHead[i], qmTail[i]);
  187. p:=qHead;
  188. while p<>nil do begin {Заполняем очереди}
  189. d:=Digit(p^.num, l, j);
  190. pTmp:=p;
  191. p:=p^.next;
  192. SetQueueNext(qmHead[d], qmTail[d], pTmp);
  193. qmTail[d]^.next:=nil;
  194. Inc(m);
  195. end;
  196. EmptyQueue(qHead, qTail);
  197. for i:=0 to mm-1 do begin { Объединяем все очереди в одну }
  198. ConcatQueues(qHead, qTail, qmHead[i], qmTail[i]);
  199. Inc(m);
  200. end;
  201. end;
  202. end;
  203.  
  204. procedure PrintQueue(qHead, qTail:PInf);{Процедура вывода очереди на экран и в файл}
  205. var
  206. p:PInf;
  207. begin
  208. p:=qHead;
  209. while p<>nil do begin
  210. Write(p^.num,' ');
  211. write(ftext, p^.num,' ');
  212. p:=p^.next;
  213. end;
  214. Writeln;
  215. writeln(ftext);
  216. end;
  217.  
  218. procedure PrintInf;{Процедура вывода на экран количества операций сравнения и пересылок}
  219. begin
  220. Writeln('C = ', c, ', M = ', m);
  221. writeln(ftext, 'C = ', c, ', M = ', m);
  222. end;
  223.  
  224. procedure Print(var qHead, qTail:PInf; s:String; keys:integer);{Процедура вывода на экран информации об очереди}
  225. begin
  226. Writeln(s,':');
  227. writeln(ftext, s,':');
  228. PrintQueue(qHead, qTail);
  229. Writeln;
  230. writeln(ftext);
  231. case keys of {Запуск процедуры сортировки масива взависимости от выбора в меню}
  232. 1:pr_DirectFusion(qHead, qTail);
  233. 2:pr_DigitalSorting(qHead, qTail);
  234. end;
  235. Writeln('Последовательность после сортировки:');
  236. writeln(ftext,'Последовательность после сортировки:');
  237. PrintQueue(qHead, qTail);
  238. Writeln;
  239. writeln(ftext);
  240. PrintInf;
  241. Writeln('Для продолжения нажмите любую клавишу...');
  242. ReadKey;
  243. end;
  244.  
  245. var
  246. qHead,qTail:PInf; {Указатели на начало и конец очереди }
  247. begin
  248. ClrScr;
  249. Writeln('Меню выбора метода сортировки последовательности целых чисел:');
  250. Writeln('1. Метод прямого слияния');
  251. Writeln('2. Методом цифровой сортировки');
  252. Write('Нажмите клавишу 1, 2');
  253. repeat
  254. key:=readkey;
  255. until (key in chis);
  256. keys:=integer(key)-48;
  257. str(keys:1,txt_filename);
  258. txt_filename:='lab3' + txt_filename + '.txt';
  259. assign(ftext, txt_filename); {Создаем текстовый файл lab1+метод.txt}
  260. {$I-}Reset(ftext);{$I+} {Ловим ошибку при отсутствии файла}
  261. if IOResult = 2 then begin
  262. Rewrite(ftext);{Если нет файла, создаем}
  263. end
  264. else begin
  265. Append(ftext);
  266. end;
  267. case keys of
  268. 1:writeln(ftext, 'Метод прямого слияния');
  269. 2:writeln(ftext, 'Методом цифровой сортировки');
  270. end;
  271. ClrScr;
  272. Write('Введите количество элементов в последовательности:');
  273. Readln(kn);
  274. writeln(ftext, 'количество элементов в последовательности - ',kn);
  275. Writeln;
  276. RandomQueue(qHead, qTail);{Генерация элементов}
  277. Print(qHead, qTail, 'Случайная последовательность',keys);
  278. Writeln;
  279. writeln(ftext);
  280. Print(qHead, qTail, 'Упорядоченная последовательность',keys);
  281. close(ftext);
  282. Writeln('Для выхода из программы нажмите любую клавишу...');
  283. ReadKey;
  284. end.

Решение задачи: «Ошибка в программе из под компилятора FPC»

textual
Листинг программы
  1. for k := 0 to 1 do
  2.       cTail[k]^.next := nil;
  3.     for k := 0 to 1 do
  4.       aHead[k] := cHead[k];
  5.     p := 2 * p;        
  6.   end;

Объяснение кода листинга программы

В данном коде выполняются следующие действия:

  1. Устанавливается значение переменной p равным 2 умножить на значение переменной p (возможно, это некорректная операция, так как переменная p еще не инициализирована).
  2. Запускается цикл от 0 до 1 с помощью выражения for k := 0 to 1 do.
  3. Внутри цикла выполняется следующее действие: cTail[k]^.next := nil;. Это выражение обращается к элементу массива cTail по индексу k и устанавливает значение поля next этого элемента в nil. Это может использоваться для обхода списка.
  4. Завершается первый цикл.
  5. Запускается второй цикл от 0 до 1 с помощью выражения for k := 0 to 1 do.
  6. Внутри цикла выполняется следующее действие: aHead[k] := cHead[k];. Это выражение присваивает значение переменной cHead по индексу k переменной aHead по тому же индексу. Это может использоваться для копирования списка.
  7. Завершается второй цикл.
  8. Выполняется операция умножения p := 2 * p;. Возможно, это некорректная операция, так как переменная p еще не инициализирована.
  9. Завершается основной блок кода.

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

12   голосов , оценка 3.417 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы