умножение чисел представленных однонаправленными списками

[NezamovMark]

прошу помощи....программа сводится к умножению столбиком, так суть в чем у меня есть куча списков, и мне надо слажить все 1-е элементы списков, 2-е элементы и так далее, помогите пожалуйста....

type
  masivchiki = array [1..99] of byte;
  mas = array [1..2] of string;
  point = ^tlist;
  golovki = array [1..99] of point;
  maski = array [1..2] of point;
  tlist = record
    info: byte;
    next: point;
  end;

var
  golova: maski;
  q,last,first,rez: point;
  golovapodgolovok: golovki;
  i, w, kakayagolova: byte;
  chislo: mas;
  col:integer;

{добавление в начало списка}
procedure nachgolov(var t: point; w: byte; i: byte);
var
  y: point;
begin
  new(y);
  y^.info := i;
  y^.next := t;
  t := y;
end;


{процедура добавления в конец списка}  
procedure addlast(var tek, last:point;  j: byte; var x:integer);
 var
    y:point;
    t:point;
 begin
 //x:=0;
  begin
    new(y);
    y^.info := j;
    y^.next :=nil;
    
      if tek = nil then begin
          tek := y;
          first := tek;
      end
      else begin
          t := tek;
    while (t^.next <> nil) do
      t := t^.next;
    t^.next := y;
    last := y;
  end;
  x:=x+1;
  end;
end;

{вывод списка}
procedure vivod(q: point);
begin
  while(q <> nil) do
  begin
    write(q^.info,' ');
    q := q^.next;
  end;
end;

{преобразование введенных данных в список}
procedure izstroki(var chislo: mas; w: byte; var kakayagolova: byte);
var
  i, e, q:byte; 
  cod: integer;
  perem: string;
begin
  i := Length(chislo[w]);
  while i > 0 do
  begin
    e := e + 1;
    perem := copy(chislo[w], e, 1);
    val(perem, q, cod);
    if kakayagolova = 1 then
    begin
      nachgolov(golova[1], w, q);
    end;
    if kakayagolova = 2 then
    begin
      nachgolov(golova[2], w, q);
    end;
    dec(i);
  end;
  
end;

{получение промежуточных значений}
procedure peremnoj (var col:integer);
var
  iq,ii, a, b, c, e, c1, c2: byte;
  i:shortint;
  q1, q2: point;
  x:integer;
begin
  //i := Length(chislo[2]);
  q1 := golova[2];
  while q1 <> nil do
  begin
    i := Length(chislo[1]);
    ii:=i;
    inc(e);
    a := q1^.info;
    q1 := q1^.next;
    q2 := golova[1];
    b := q2^.info;
    c2 := 0;
    x:=0;
    while q2 <> nil do
   begin
      c := a * b;
      c := c + c2;
      if i > 1 then
      begin
        c1 := c mod 10;
        c2 := c div 10;
        q2 := q2^.next;
        b := q2^.info;
      end;
      if i = 1 then
      begin
        c1 := c mod 10;        
        addlast(golovapodgolovok[e],last, c1,x);
        c1 := c div 10;
        q2 := q2^.next;
      end;
      dec(i);dec(ii);
      addlast(golovapodgolovok[e], last, c1,x);        
    end;
  end;
  x:=x+e-1;
  begin
   i := Length(chislo[2]);
   iq:=i;
   for i:=e downto 1 do
    begin
     iq:=i-1;
     while iq <> 0 do
      begin
       nachgolov(golovapodgolovok[e], w, 0);
       dec(iq);
      end;dec(e);
    end;
  end; 
  col:=x;
end;

function Sum(m: masivchiki;e:byte): byte;
Var   i, s : Integer;
Begin
   sum:=0;
   //e := Length(chislo[1]);
   for i :=1 to e do
     s:=s+m[i];
     sum:=s;
End;

procedure symm(kol:integer;t:integer);
 var a:masivchiki;
     q:array [1..999] of point;
     e,i,b:byte;
     r,w:integer;
begin
 //e := Length(chislo[2]);
 for r:=1 to kol do 
  begin inc(w);
    for i :=1 to t do
      
      begin     
      q[i]:= golovapodgolovok[i];
      a[i] := q[w]^.info;
      q[i] := q[w]^.next;
      b:=sum(a,e);
      end;
  nachgolov(rez, w, b);
  end 
end;

begin
  for i := 1 to 2 do                           //запись чисел
  begin
    w := w + 1;
    inc(kakayagolova);
    write('введите ', w, ' число: '); 
    readln(chislo[i]);                        //ввод числа
    izstroki(chislo, w, kakayagolova);        //превращение в список
    write('число ', w, ' в виде списка: ');
    if w = 1 then 
      q := golova[1]
    else
      q := golova[2];
    vivod(q);                      //вывод переработанного списка
    writeln();
  end; 
  w := Length(chislo[2]);
  peremnoj(col);  
  writeln(col);
  for i := 1 to w do
  begin
    q := golovapodgolovok[i];
    vivod(q); 
    writeln();
  end;
  symm(col,w);
end.