Дополнительные программы для работы с динамической
памятью
{Демонстрация использования указателей массива}program d point4; type
field=array f 1.. 10] of integer; var
i: integer; f: field: zf: "field, begin
fori:"l to 10 do
f[ij:=10*i; {Заполнение массива} zf~@f; {Указателю zf присваивается адрес начала
размещения массива в памяти} writeln(zfA[l]); {Напечатать значение 1-го элемента
массива, на который указывает указатель zf}
zf:=@f[2]; {Присвоить указателю zf адрес размещения 2-го элемента массива} writeln(zfA[l]); {Напечатать значение 1-го элемента
массива, на который указывает указатель zf} zf:=ptr(seg(fJ3]),ofs(f[3j)+sizeof(integer)); {Присвоить указателю zf адрес
4-го элемента массива} writeln(zfA[ij) {Напечатать значение 1-го элемента массива, на который
указывает zf} end.
{Программа для демонстрации использования динамической памяти} program d_point5;
type intptr=Amteger; {Описание типа указателя на целое} recptr=Arecordtype, {Описание типа указателя на запись recordtype} recordtype=record {Описание типа записи recordtype} name:strmg[20]; number:integer end; var intl,int2,pl,p2 : intptr;
he: recptr; x,y,i: integer;
p: Abyte; begin
p:=ptr($40,$49); {Присвоить указателю р адрес ячейки памяти, для которой S40 - сегмент, $49 - смещение в шестнадцатеричном коде; по этому адресу записан текущий видеорежим} write]п('Текущий видеорежим : ',рл);
writeln(memavail.' байт всего свободно в памяти (размер кучи)'); writeln('O6beM наибольшего непрерывного свободного блока кучи = ',maxavail,' байт'); «т!1е('Введите два целых числа :'); readln(x.y);
new(intl); {Создать новую динамическую переменную intl и установить на нее указатель}
intl А:=х; {Записать но адресу, указанному intl, значение переменной х} writeln('x=',x,' intlA=',int!A);
new(int2); {Создать новую динамическую переменную int2 и установить на нее указатель}
int2A:=y; {Записать но адресу, указанному int2, значение переменной у} writeln('y=',y,' int2A=',mt2A);
{Подсчитать размер динамической памяти для размещения одной записи recordtype и вывести сообщение}
writeln('flna одной записи нужно ',sizeof(recordtype),' байт1); new(he); {Создать новую динамическую переменную he и установить на нее указатель}
у\тНе('Введите вашу фамилию и имя :');
readln(heA.name); {Считать в динамическую память значение фамилии и имени} write('CmnbKo Вам лет:');
readin(heA.number); {Считать в динамическую память значение возраста} {Напечатать на экране значения полей name и number} writeln('heA.name=',heA.narne,' heA.number=',heA.number);
{Сравнить значения heA.number и intlA и выполнить соответствующие операции} if heA.number>int IA then y:=heA.number else
y:=-intlA; writeln('y=',y);
dispose(intl); {Освободить память, отведенную для указателя intl под значение типа integer} dispose<mt2); dispose(he);
pi ~@х; {Присвоить указателю pi адрес переменной х} p2:=addr(y); {Присвоить указателю р2 адрес переменной у} writeln(p 1А); {Напечатать значение переменной х} p2:=pl; {Указателю р2 присвоить адрес переменной х} у:=р2А; {Присвоить переменной у значение переменной х} {Сравнить значения адресов, по которым в динамической
памяти записаны переменные х и у! if @х о @у then \¥п1е!п('3начения адресов переменных writeln(y); {Выводит значение у, равное значению х} end.
х и у не равны');
{Программа считывает файл целых чисел, состоящий из нескольких последовательностей чисел, каждая из которых оканчивается числом -1, и затем выводит эти последовательности чисел в выходной файл, но внутри каждой из них расставляет числа в обратном порядке}
program djoint6;
type
pointer=Adataset; {Определение указателя на запись dataset}
dataset=record
data : integer; {Поле - целое число} point: pointer {Поле - нетипизированный указатель} end; var
r!,r2 ; pointer; {Нетипизированный указатель} m,i,k : integer; {Вспомогательные переменные} inp,out: file of integer; {Файловые переменные:
inp - исходный файл целых чисел, out - выходной файл целых чисел} begin
{Создание исходного файла при первом запуске данной прграммы } writelnfnpH первом запуске данной программы введите число 1, иначе, - любое.
i\ 'i litt
число); readln(m); if m=l then begin
assign(inp,'mput.dat'); rewrite(inp):
for k:=l to 20 do {Создать файл из 20 чисел} begin
итце('Введите ',k,'-e число:'); readln(i);
write(inp.i) {Записать в исходный файл очередное число} end:
close(inp) {Завершение создания исходного файла чисел} end;
assign(inp,'input.daf);
reset(inp); {Открыть исходный файл input.dat} assign(out,'output.dat');
rewrite(out); {Открыть выходной файл output.dat}
while not eof(mp) do {Пока не будет обнаружен конец исходного файла} begin
r!:=nil; {Установить указатель г! на nil} read(inp,i); {Читать из исходного файла число в переменную i} while i о -1 do {Пока значение переменной i не равно -1 (конец
последовательности)} begin new(r2); {Создать новую динамическую перемешгую и установить
на нее указатель} r2A.data:-i; {Записываем в поле data динамической переменной dataset,
адрес которой указывает г2 (первой в создаваемой в динамической памяти цепочки), значение переменной i -очередного числа последовательности} r2A.point:=rl; {Записываем в поле point динамической переменной
dataset, адрес которой указывает г2, значение указателя} rl :=г2; {Теперь указатель rl указывает на новый объект в цепочке чисел} read(inp,i) {Читать из исходного файла число в переменную i) end;
r2:=rl; {Указать начало следующей последовательности чисел} while r2 о nil do {Пока значение указателя г2 о nil} begin write(oul,r2A.data); {Записать в выходной файл значение ноля data
динамической памяти} write(r2A.data); {Напечатать на экране (для контроля) значение поля
data динамической памяти, на которую указывает г2} г2~r2A.point; {Присваиваем г2 значение поля point динамической переменной
dataset, указывающей на следующее число в последовательности} end;
write(out,i), {Записать в выходной файл i—1} writeln; end;
dispose(rl); {Освободить динамическую память) closc(inp); {Закрыть имсходный файл} close(out) {Закрыть выходной файл} end.
{При первичном запуске программы введите 20 целых чисел, разделяя их на последовательности числом -1, например: 1,3,5,-1,0,3,5,6,-1,9,2,4, -1,2,33,4,21,33,7,-!}
{Программа создает список, содержащий сведения об автомобилях, иллюстрирует некоторые операции со связанными списками: запись первым в список, удаление любого элемента списка; просмотр всего списка)
program d j}oint7; uses crt; type
namestr=string[20|; {Марка автомобиля) link=Aavto; avto=record
name : namestr; {Марка автомобиля) speed : real; {Скорость автомобиля}
next: link; {Поле для связи со следующим объектом в списке) end; var
p,fist: link; {Указатели на запись: текущую, первую) namcfind : namestr; {Марка автомобиля для поиска) v : 0..4; {Селектор мемю) endmenu : boolean; {Окончание вывода меню)
procedure fmd(fn:namestr; var findname:link;var tek:link ); {Поиск объекта с именем fh, по результатам поиска возвращает указатель на предыдущий объект списка; либо на первый объект, если найденный объект первый в списке) var
pred : link; {Указатели адресов текущего и предыдущего объекта в списке)
begin
tek:=fist; {Установить указатели на первом объекте списка} pred:=fist;
while tek о nil do {Повторять пока не дойдем до конца списка) begin
if tekA.name=fn then {Если нашли заданный объект) begin
findname:=pred, {Возвращаем значение указателя на предыдущий объект) exit; {Завершаем функцию для прекращения дальнейшего поиска) end else
pred:=tek;
tek:^tckA.next {Перейти к следующей записи) end;
fmdname:=p.il; {В списке нет искомого объекта) end;
procedure addfist(a:link); {Добавление записи первой в связанный список) begin
a\next:=fis1; {Новый объект первый в списке) fist:=a; {Голова списка ссылается на новый объект) end;
procedure deifist(var a:link); {Удаление первого объекта из списка) begin a:=fist; {Переменной а присваивается значение указателя
на удаляемый объект) ;
fist:=fistA.next; (Теперь fist указывает на тот объект, на который
ранее ссылался объект а} end; procedure delafter(ord:link: var a:link): {Удаление из списка объекта,
стоящего после объекта ord) begin a:=ordA.next, {Переменной а присваивается значение указателя
на удаляемый объект)
ordA.next:=ordA.nextA.next; {Теперь ord ссылается на тот объект, на который ранее ссылался следующий за ним объект, а объект а исключен из списка) end;
procedure del; {Удаление любого объекта в списке} var
рр : link: begin
w гг£с('Введите марку автомобиля для удаляемого бъекта :'): readln(namefind);
find(namefind,pp,p); {Поиск адреса предыдущего объекта) if рр о nil then {Поиск успешный} begin
if (рр - fist) and (p=fisl) then delfist(p) {Если удаляемый объект первый в списке} else delafterfpp.p); dispose(p) {Освобождается динамическая память, но адресу,
содержащемуся в указателе р) end
else {Поиск неуспешный)
writeln('O6bCKra с такой маркой автомобиля в списке нет'); wtriteln('Для продолжения работы нажмите клавишу Enter'); readln
end;
procedure inpavto; [Ввод нового объекта в начало списка}
begin
p:=new(link); {Резервируем динамическую память под вводимый объект}
шп1е('Введите марку автомобиля :');
readln(pA.name);
«т11е('Максимальная скорость :');
readln(pA.speed);
addfist(p), {Вызов процедуры записи объекта в начало списка}
end;
procedure mylist, {Вывод на экран списка всех объектов}
var
curr : link;
begin
curr:=fist; { Установить указатель на первый объект списка)
while curr о nil do {Повторять пока не дойдем до конца списка} begin
writeln('MapKa : ',currA.name.' скорость : '.cunAspeed); curr:=currA.next, {Переюи к очередному объекту списка}
end;
write('Bbmofl списка окончен. Нажмите Enter');
readln
end;
begin {Основная программа}
fist^nil; {Пока списка нет}
endmenu:=false;
repeat {Очищать экран и выводить меню до тех пор, пока cndmenu о true}
clrscr, {Очистка экрана}
writeln('Укaжитe вид работы:'),
writeln('l - Запись объекта в начало списка');
writeln('2 - Удаление указанного объекта из списка');
writeln('3 - Просмотр всего списка объектов');
writeln('0 - Окончание работы');
readln(v);
case v of {Вызов разных процедур в зависимости от выбора пункта меню}
1 : inpavto;
2 : del;
3 : mylist else
endmenu:^true {Завершить работу меню}
end;
until endmenu {если endmenu=true, то завершить вывод меню на экран} end.
