Расчет производится верно, но программа с огромной скоростью пожирает память (~ 3GB за 4 сек и потом лезет в SWAP).
Который день не могу отловить эту ошибку. valgrind показывает, что утечки происходят во время действий/операций с созданным классом. А где, в упор не понимаю.
Кому не сложно --- помогите, гляньте свежим глазом.
ОС: Ubuntu 10.10, FPC 2.4.0
Вот часть кода программы:
1. fpc-model.pas
- Код: Выделить всё
program Model;
uses crt, mclasses, gfclasses, convert, sysutils;
BEGIN
gf_stepen := 5;
gf_polynom := '101001';
SetGF;
SetGFDBazis;
// ...
// Очищаем память
GFFreeMem;
END.
2. gfclasses.pas
- Код: Выделить всё
unit gfclasses;
{$mode objfpc}{$H+}
{$ASMMODE INTEL}
interface
uses convert, classes, sysutils;
type
TGFElement = class
private
z: integer; // Значение элемента (десятичное)
public
procedure zero; // Обнуление элемента
function ifnotzero: boolean; // Если элемент не равен 0, то возвращает true
function exponent: integer; // Возвращает показатель степени элемента поля (!! ПОДУМАТЬ: что если значение равно нулю)
//function value: integer; // Возвращает значение элемента поля
function print: string;
function printtex: string;
constructor Create;
destructor Destroy; override;
end;
operator +(const a,b: TGFElement)r: TGFElement;
operator *(const a,b: TGFElement)r: TGFElement;
operator /(const a,b: TGFElement)r: TGFElement;
operator **(const a: TGFElement; const b: integer)r: TGFElement; // Возведение в степень
operator :=(a: integer)r: TGFElement;
// П/п вычисления поля Галуа по заданным параметрам (степень и образ. полином)
procedure SetGF;
// П/п вычисления двойственного базиса поля
procedure SetGFDBazis;
// П/п освобождения памяти
procedure GFFreeMem;
var
// Параметры поля Галуа
gf_stepen: integer; // Степень поля
gf_stepenm1: integer; // Степень поля за вычетом 1 (для всяких циклов)
gf_stepenp1: integer; // Степень поля плюс 1 (для всяких циклов и выделения памяти)
gf_count: integer; // Число элементов поля
gf_countm1: integer; // Число элементов поля хза вычетом 1 (для всяких циклов)
gf_vychet: integer; // Вычет образующего полинома
gf_polynom: shortstring; // Образующий полином
gf_dbazis: array of TGFElement; // Двойственный базис поля
// Массивы для хранения таблицы поля
dte: array of integer; // Массив степеней элементов поля по их значению
etd: array of integer; // Массив значений элементов поля по их степени
// |-------------------------------------------------------------------|
// | РАЗДЕЛ ОПРЕДЕЛЕНИЯ ПРОЦЕДУР И ФУНКЦИЙ |
// |-------------------------------------------------------------------|
implementation
// == П/П вычисления поля Галуа ========================================
procedure SetGF;
var i,j: integer; // Счетчик
l: integer; // Длина образующего полинома
s: string; // Строка для накопления вычета полинома
label z;
begin
// Делаем проверку: были ли получены степень поля и образующий полином
if (gf_stepen=0)or(gf_polynom='0') then begin
writeln('!!! Ошибка: не введен какой-то из параметров поля Галуа');
halt(0);
end;
// == Считаем количество элементов поля
gf_count := (1 shl gf_stepen) - 1;
// == Считаем вычет образующего полинома
l := Length(gf_polynom);
s := '';
for i:=0 to l-2 do s := s + gf_polynom[l-i];
gf_vychet := BinToDec(s);
// == Считаем пределы для циклов
gf_stepenm1 := gf_stepen - 1;
gf_stepenp1 := gf_stepen + 1;
gf_countm1 := gf_count - 1;
// == Считаем таблицы значений и степеней элементов поля
// Выделяем память под таблицы
SetLength(dte, gf_count+1);
SetLength(etd, gf_count);
// Прописываем начальные значения
dte[0] := 0;
i := 1 shl gf_stepenm1;
etd[0] := i;
dte[i] := 0;
// Начинаем перебор значений и запись их в таблицы
j := 1;
repeat
asm
SHR i,1
JNC z
MOV EAX,i
XOR EAX,gf_vychet
MOV i,EAX
z: NOP
end;
etd[j] := i;
dte[i] := j;
Inc(j);
until(j=gf_count);
// == Выводим параметры поля
writeln;
writeln('Задано поле: GF(2^', IntToStr(gf_stepen),')');
writeln('Обр-й полином: p(x) = ', VekToPol(gf_polynom), ' = ', ConstBin(gf_polynom, gf_stepen+1));
writeln('Вычет полинома: ',IntToStr(gf_vychet));
writeln;
end;
// ---------------------------------------------------------------------
// == П/п вычисления дв. базиса поля ===================================
procedure SetGFDBazis;
var i: integer; // Счетчики
e0,e1: TGFElement; // Переменные для хранения e^0=1 и e^1=e элементов поля
proizv: TGFElement; // Переменная для хранения производной
begin
// Инициализируем массив дв. базиса
SetLength(gf_dbazis, gf_stepenp1); // Выделяем память
for i:=0 to gf_stepen do gf_dbazis[i]:=TGFElement.Create; // Создаем элементы массива -- Нулевой элемент в дальн. использоваться не будет
{ Считаем дв. базис по формуле
* a_i = SUM_[j=0]^[k-i] [p_[k-i-j]*e^j] / p'(e)
* где i = 1,2,...,k; GF(2^k)
* e = элемент поля степени 1}
// Создаем переменные для хранения e^0=1 и e^1=e элементов поля и инициализируем их
e0 := TGFElement.Create;
e1 := TGFElement.Create;
e0 := 0;
e1 := 1;
// Cоздаем переменную для хранения производной образ. полинома
proizv := TGFElement.Create;
// Считаем производную p'(e)
if gf_polynom[gf_stepen]='1' then proizv:=0;
for i:=gf_stepen-1 downto 1 do
if (((gf_stepenp1-i) mod 2)<>0)and(gf_polynom[i]='1') then
proizv := proizv + (e1**(gf_stepenp1-i-1));
// Вычисляем последний элемент дв. базиса
gf_dbazis[gf_stepen] := e0 / proizv;
// Вычисляем остальные элементы дв. базиса как
// db[i-1] := (p_[gf_stepen-i] / p'(e)) + (e * db[i])
// см. пример 4.10 из книги Когновицкого О.С. "Двойственный базис ..."
for i:=gf_stepenm1 downto 1 do begin
gf_dbazis[i] := e1 * gf_dbazis[i+1];
if gf_polynom[gf_stepen-i+1]='1' then
gf_dbazis[i] := gf_dbazis[i] + (e0 / proizv);
end;
// Выводим дв. базис
write('Дв. базис: ');
for i:=1 to gf_stepen do
write(gf_dbazis[i].print,' ');
writeln;
// Уничтожаем служебные переменные
FreeAndNil(e0);
FreeAndNil(e1);
FreeAndNil(proizv);
end;
// ---------------------------------------------------------------------
// == П/п освобождения памяти ==========================================
procedure GFFreeMem;
var i: integer; // Счетчики
begin
// Уничтожаем объекты
for i:=0 to gf_stepen do FreeAndNil(gf_dbazis[i]);
// Удаляем динамический массив
gf_dbazis := nil;
end;
// ---------------------------------------------------------------------
// == Конструктор элемента поля == начало
constructor TGFElement.Create;
begin
z := 0;
end;
// -- Конструктор элемента поля -- конец
// == Обнуление элемента == начало
procedure TGFElement.zero;
begin
z := 0;
end;
// -- Обнуление элемента -- конец
// == Возвращает TRUE, если элемент ненулевой == начало
function TGFElement.ifnotzero: boolean;
begin
if z=0 then ifnotzero := false
else ifnotzero := true;
end;
// -- Возвращает TRUE, если элемент ненулевой -- конец
// == Возвращает показатель степени элемента поля == начало
function TGFElement.exponent: integer;
begin
if z>0 then exponent := dte[z]
else exponent := -1;
end;
// -- Возвращает показатель степени элемента поля -- конец
// == Вывод элемента поля в обычную строку == начало
function TGFElement.print: string;
begin
if z > 0 then begin
if dte[z]=0 then print:='1'
else if dte[z]=1 then print:='e'
else print:='e'+IntToStr(dte[z])
end
else print:='0';
end;
// -- Вывод элемента поля в обычную строку -- конец
// == Вывод элемента поля в строку TeX == начало
function TGFElement.printtex: string;
begin
if z > 0 then begin
if dte[z]=0 then printtex:='1'
else if dte[z]=1 then printtex:='\varepsilon'
else printtex:='\varepsilon^{'+IntToStr(dte[z])+'}'
end
else printtex:='0';
end;
// -- Вывод элемента поля в строку TeX -- конец
// == Деструктор элемента поля == начало
destructor TGFElement.Destroy;
begin
//
end;
// -- Деструктор элемента поля -- конец
// == Оператор '+' для элемента поля == начало
operator +(const a,b: TGFElement)r: TGFElement;
begin
r := TGFElement.Create;
r.z := a.z xor b.z;
end;
// -- Оператор '+' для элемента поля -- конец
// == Оператор '*' для элемента поля == начало
operator *(const a,b: TGFElement)r: TGFElement;
begin
r := TGFElement.Create;
if (a.z=0)or(b.z=0) then r.z:=0
else begin
r.z := dte[a.z] + dte[b.z];
// Проверяем на выход из диапазона
while r.z>=gf_count do r.z := r.z - gf_count;
while r.z<0 do r.z := r.z + gf_count;
// Возвращаем значение
r.z := etd[r.z];
end;
end;
// -- Оператор '*' для элемента поля -- конец
// == Оператор '/' для элемента поля == начало
operator /(const a,b: TGFElement)r: TGFElement;
begin
r := TGFElement.Create;
if (a.z=0) then r.z:=0
else if b.z=0 then begin
writeln('!!! Ошибка: Деление на ноль');
halt(0);
end
else begin
r.z := dte[a.z] - dte[b.z];
// Проверяем на выход из диапазона
while r.z<0 do r.z := r.z + gf_count;
r.z := etd[r.z];
end;
end;
// -- Оператор '/' для элемента поля -- конец
// == Оператор '**' (возв. в степень) для элемента поля == начало
operator **(const a: TGFElement; const b: integer)r: TGFElement;
begin
r := TGFElement.Create;
if (a.z=0) then r.z:=0
else begin
r.z := dte[a.z] * b;
// Проверяем на выход из диапазона
while r.z>=gf_count do r.z := r.z - gf_count;
while r.z<0 do r.z := r.z + gf_count;
// Возвращаем значение
r.z := etd[r.z];
end;
end;
// -- Оператор '**' (возв. в степень) для элемента поля -- конец
// == Оператор 'TGFEl := integer' для элемента поля == начало
operator :=(a: integer)r: TGFElement;
begin
r := TGFElement.Create;
//while a<0 do a := a + gf_count;
//while a>=gf_count do a := a - gf_count;
if a>=0 then r.z := etd[a];
if a=-1 then r.z := 0;
end;
// -- Оператор 'TGFEl := integer' для элемента поля -- конец
end.
3. convert.pas
- Код: Выделить всё
unit convert;
{$mode objfpc}{$H+}
{$ASMMODE INTEL}
interface
uses classes, sysutils;
// Функции преобразования
function DecToBin(d: integer): string;
function BinToDec(s: string): integer;
function PolToVek(s: string): string;
function VekToPol(s: string): string;
function ConstBin(s: string; n: integer): string; //
function ConstStr(s: string; n: integer; z: char): string; //
const
// Символы, использующиеся при записи DEC числа
SetDec: set of char = ['-','0','1','2'..'9'];
// Символы, использующиеся при записи BIN числа
SetBin: set of char = ['0','1'];
// Символы, использующиеся для записи операций
SetDiv: set of char = ['+','*','/'];
// Символы десятичных цифр
SetNum: set of char = ['0','1','2'..'9'];
// Символы, использующиеся для записи операций
SetOpr: set of char = ['+','*','/','^'];
implementation
{== Преобразует DEC в BIN =====================================================}
function DecToBin(d: integer): string;
var w,j: integer;
str: string;
begin
w := d;
str := '';
if w=0 then str := '0'
else begin
j := 1073741824;
//writeln('w=',IntToStr(w),' j=',IntToStr(j1));
while (w<j) do j := j div 2;
//writeln('w=',IntToStr(w),' j=',IntToStr(j1));
repeat
str:=str+IntToStr(w div j);
if w>=j then w := w - j;
j := j div 2;
//writeln('w=',IntToStr(w),' j=',IntToStr(j1), ' str=',str1);
until(j=0);
end;
DecToBin := str;
end;
{------------------------------------------------------------------------------}
{== Преобразует BIN в DEC =====================================================}
function BinToDec(s: string): integer;
var w, l, r: integer;
begin
l := Length(s);
r := 0;
for w:=l downto 1 do begin
if s[w]='1' then
r := r + (1 shl (l - w));
end;
BinToDec := r;
end;
{------------------------------------------------------------------------------}
{== Преобразует POL в VEK =====================================================}
function PolToVek(s: string): string;
var j, l: integer; // Счетчик
tek, max: integer;
s_num: string; // Сюда читается степень при 'x'
s_vk: string; // Строка в которую вначале читается вектор
begin
s_vk := '';
l := length(s);
j := 1;
max := 0; // Ищем максимальную степень
repeat
if s[j]='x' then begin
j := j + 1;
s_num := '';
repeat
s_num := s_num + s[j];
j := j + 1;
until((j > L) or not(s[j] in SetDec));
tek := StrToInt(s_num);
if tek>max then max:=tek
end
else
j := j + 1;
until(j > l);
for j:=max downto 2 do begin // Прогоняем все степени от максимальной до 2
l := 0;
while Pos('x'+IntToStr(j), s)>0 do begin
tek := Pos('x'+IntToStr(j), s);
if (tek>0) then l := l xor 1;
Delete(s, tek, Length(IntToStr(j)) + 1);
end;
s_vk := s_vk + IntToStr(l);
end;
l := 0; // Прогоняем степень 1 : х1
while Pos('x1', s)>0 do begin
tek := Pos('x1', s);
if (tek>0) then l := l xor 1;
Delete(s, tek, Length(IntToStr(j)) + 1);
end;
s_vk := s_vk + IntToStr(l);
l := 0; // Прогоняем степень 0 : 1
while Pos('1', s)>0 do begin
tek := Pos('1', s);
if (tek>0) then l := l xor 1;
Delete(s, tek, Length(IntToStr(j)) + 1);
end;
s_vk := s_vk + IntToStr(l);
PolToVek := s_vk;
end;
{------------------------------------------------------------------------------}
{== Преобразует VEK в POL =====================================================}
function VekToPol(s: string): string;
var u: integer; // Счетчик
len: integer; // Длина вектора
s_pl: string; // Cюда читается полином
begin
len := Length(s);
s_pl := '';
if BinToDec(s)=0 then s_pl := '0'
else begin
for u:=1 to len-1 do begin
if s[u]='1' then
s_pl := s_pl + 'x' + IntToStr(len-u) +'+';
end;
if s[len]='1' then
s_pl := s_pl + '1'
else
Delete(s_pl, Length(s_pl), 1);
end;
VekToPol := s_pl;
end;
{------------------------------------------------------------------------------}
{== Приводит BIN число к определенной длине ===================================}
function ConstBin(s: string; n: integer): string;
var l, j: integer;
add: string;
begin
l := Length(s);
add := '';
if n>l then begin
for j:=1 to n-l do
add := add + '0';
end;
ConstBin := add + s;
end;
{------------------------------------------------------------------------------}
{== Дополняет строку символами ло определенной длины ==========================}
function ConstStr(s: string; n: integer; z: char): string;
var l, j: integer;
add: string;
begin
l := Length(s);
add := '';
if n>l then begin
for j:=1 to n-l do
add := add + z;
end;
ConstStr := add + s;
end;
{------------------------------------------------------------------------------}
end.
4. Вывод valgrind
- Код: Выделить всё
$ valgrind --trace-children=yes --leak-check=full ./fpc-model
==30885== Memcheck, a memory error detector
==30885== Copyright (C) 2002-2010, and GNU GPL'd, by Julian Seward et al.
==30885== Using Valgrind-3.6.0.SVN-Debian and LibVEX; rerun with -h for copyright info
==30885== Command: ./fpc-model
==30885==
Задано поле: GF(2^5)
Обр-й полином: p(x) = x5+x3+1 = 101001
Вычет полинома: 18
Дв. базис: 1 e30 e29 e2 e
==30885==
==30885== HEAP SUMMARY:
==30885== in use at exit: 260 bytes in 13 blocks
==30885== total heap usage: 68 allocs, 55 frees, 11,490 bytes allocated
==30885==
==30885== 20 bytes in 1 blocks are definitely lost in loss record 1 of 8
==30885== at 0x4C2815C: malloc (vg_replace_malloc.c:236)
==30885== by 0x42E1C6: CMEM_CGETMEM$QWORD$$POINTER (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x4326A5: GFCLASSES_SETGFDBAZIS (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x40FC68: main (fpc-model.pas:31)
==30885==
==30885== 20 bytes in 1 blocks are definitely lost in loss record 2 of 8
==30885== at 0x4C2815C: malloc (vg_replace_malloc.c:236)
==30885== by 0x42E1C6: CMEM_CGETMEM$QWORD$$POINTER (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x4326C2: GFCLASSES_SETGFDBAZIS (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x40FC68: main (fpc-model.pas:31)
==30885==
==30885== 20 bytes in 1 blocks are definitely lost in loss record 3 of 8
==30885== at 0x4C2815C: malloc (vg_replace_malloc.c:236)
==30885== by 0x42E1C6: CMEM_CGETMEM$QWORD$$POINTER (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x4326FB: GFCLASSES_SETGFDBAZIS (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x40FC68: main (fpc-model.pas:31)
==30885==
==30885== 20 bytes in 1 blocks are definitely lost in loss record 4 of 8
==30885== at 0x4C2815C: malloc (vg_replace_malloc.c:236)
==30885== by 0x42E1C6: CMEM_CGETMEM$QWORD$$POINTER (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x432F40: GFCLASSES_plus$TGFELEMENT$TGFELEMENT$$TGFELEMENT (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x43279E: GFCLASSES_SETGFDBAZIS (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x40FC68: main (fpc-model.pas:31)
==30885==
==30885== 20 bytes in 1 blocks are definitely lost in loss record 5 of 8
==30885== at 0x4C2815C: malloc (vg_replace_malloc.c:236)
==30885== by 0x42E1C6: CMEM_CGETMEM$QWORD$$POINTER (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x432F90: GFCLASSES_star$TGFELEMENT$TGFELEMENT$$TGFELEMENT (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x43280A: GFCLASSES_SETGFDBAZIS (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x40FC68: main (fpc-model.pas:31)
==30885==
==30885== 20 bytes in 1 blocks are definitely lost in loss record 6 of 8
==30885== at 0x4C2815C: malloc (vg_replace_malloc.c:236)
==30885== by 0x42E1C6: CMEM_CGETMEM$QWORD$$POINTER (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x4330A4: GFCLASSES_slash$TGFELEMENT$TGFELEMENT$$TGFELEMENT (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x43284C: GFCLASSES_SETGFDBAZIS (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x40FC68: main (fpc-model.pas:31)
==30885==
==30885== 40 bytes in 2 blocks are definitely lost in loss record 7 of 8
==30885== at 0x4C2815C: malloc (vg_replace_malloc.c:236)
==30885== by 0x42E1C6: CMEM_CGETMEM$QWORD$$POINTER (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x4331C7: GFCLASSES_starstar$TGFELEMENT$LONGINT$$TGFELEMENT (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x432792: GFCLASSES_SETGFDBAZIS (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x40FC68: main (fpc-model.pas:31)
==30885==
==30885== 100 bytes in 5 blocks are definitely lost in loss record 8 of 8
==30885== at 0x4C2815C: malloc (vg_replace_malloc.c:236)
==30885== by 0x42E1C6: CMEM_CGETMEM$QWORD$$POINTER (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x432673: GFCLASSES_SETGFDBAZIS (in /home/vlss/Project/free-pascal/fpc-modelirovanie/fpc-model)
==30885== by 0x40FC68: main (fpc-model.pas:31)
==30885==
==30885== LEAK SUMMARY:
==30885== definitely lost: 260 bytes in 13 blocks
==30885== indirectly lost: 0 bytes in 0 blocks
==30885== possibly lost: 0 bytes in 0 blocks
==30885== still reachable: 0 bytes in 0 blocks
==30885== suppressed: 0 bytes in 0 blocks
==30885==
==30885== For counts of detected and suppressed errors, rerun with: -v
==30885== ERROR SUMMARY: 8 errors from 8 contexts (suppressed: 4 from 4)
Прорблема то у Вас с памятью, а не с быстродействием.
а насчёт того, что сказал Горелкин: предлагаю суперсредство. Два конструктора. Один помечает объект как юзверьский, другой создаёт объект как временный... и когда result = nil, то создавать в операторе результат временным конструктором, иначе класть в уже существующий result результат. иначе делать временным и потом в том же операторе если один из операндов временный, то тереть его... ну и ясно, что я хочу сказать, да?