нетипичная задача на списки, сложение и умножение чисел Опции

[alex-it]

Условие: вводится последовательность натуральных чисел и создаётся из неё список. Длина последовательности n. Обеспечить с помощью списка вычисление сумм и произведений вида:

1) x1*xn + x2*xn-1 + ... + xn*x1

2)(x1+xn)*(x2+xn-1)* ... *(xn+x1)

собственно, идея у меня такая: создается еще один список(такой же, как первый), и в цикле перемножаются 1,2,3...(пока не дойдет до nil) X из первого списка на последний X из второго списка(каждый раз последний Х удаляется соответственно). все вспомогательные процедуры вроде работают, но вот сумму никак не могу посчитать! если кого-то заинтересует, подскажите, пожалуйста! заранее спасибо.

[alex-it]

вроде в условии не оговаривается, так что по идее можно делать как угодно... я пытался делать с односвязными

Код

type
    pn=^mark;
  mark=record
   a:integer;
   next:pn;
   end;
  mas_i=array[1..100] of integer;

{Здесь создается простой массив из натуральных чисел}
procedure input(var n:integer; var mas:mas_i);
 var
  i:integer;
 begin
  Write('Input the size of massive: ');
   readln(n);
    for i:=1 to n do
     begin
      mas[i]:=Random(5)+1;
         end;
   write('Ishodnaya posledovatelnost: ');
   for i:=1 to n do write(mas[i], ' ');
   writeln('');
   end;

 {Здесь создается список}
 procedure add(var lp:pn; n:integer; mas:mas_i);
  var
   p:pn;
   i:integer;
   begin
    for i:=1 to n do
     if mas[i]<>0 then
       begin
         new(p);
           p^.a:=mas[i];
          p^.next:=lp;
        lp:=p;
        end;
       end;

 {Функция возвращает последний элемент списка}
 function getlast(p:pn):pn;
  begin
 if (p<>nil) then
  begin
 while (p^.next<>nil) do
  p:=p^.next;
 getlast:=p;
   end
   else
  getlast:=nil;
  end;

  {Функция возвращает предпоследний элемент списка}
 function getprelast(p:pn):pn;
  var
  p1:pn;
   begin
    if (p<>nil) then
     begin
    p1:=p;
     repeat
       p:=p1;
        if (p^.next<>nil) then
     p1:=p^.next;
    until (p1^.next=nil);
   getprelast:=p;
    end
     else
      getprelast:=nil;
  end;

 {В этой процедуре происходит удаление последнего элемента списка}
 procedure getdell(var p:pn);
  var
   p1:pn;
  begin
     if (p<>nil) then
    if (p^.next=nil) then
      begin
       p1:=p;
        p:=p^.next;
       dispose(p1);
      end
       else
       begin
     p1:=getprelast(p);
      dispose(p1^.next);
       p1^.next:=nil;
     end;
  end;

 {Здесь происходит вычисление суммы(1). Собственно, здесь и проблема. При таком варианте программа просто вылетает.}
 procedure summ(lp:pn; sum:integer);
   var ls,p:pn;
   begin
       new(ls);
       ls:=lp;
       sum:=0;
    while (lp<>nil) do
     begin
       p:=getlast(ls);
        sum:=sum+(lp^.a)*(p^.a);
          lp:=lp^.next;
            getdell(ls);
           end;
      writeln('Summa ravna ', sum);
   end;