program aufgabe25;
var a,b :  integer;

(* Musterloesung Teil a*)
function getBinLength(x,y : integer):integer;
var temp,i : integer;
begin
   if (x>y) then temp := x else temp := y;
   i := 1;
   while (temp > 1) do begin
      temp := temp div 2;
      i := i + 1;
   end;
   getBinLength := i;
end; { getBinLength }

function int2binstr(x,laenge : integer):string;
var ergebnis : string;
    rest,i,j : integer;
    ziffer   : char;
begin
   ergebnis := '';
   i := 1;
   while ((x > 0) and (i<=laenge)) do begin
      rest := x mod 2;
      x := x div 2;
      ziffer := '0';
      if (rest=1) then ziffer := '1';      
      ergebnis := ziffer + ergebnis;
      i := i + 1;
   end;
   for j:=i to laenge do ergebnis := '0' +ergebnis;
   int2binstr := ergebnis;
end; { int2binstr }

(* Musterloesung Teil b *)
(* ein Rechts-Shift über alle drei Register *)
procedure shift(var r : char; var ac1,ac0 : string);
var i : integer;
begin
   for i := length(ac0) downto 2 do ac0[i] := ac0[i-1];
   ac0[1] := ac1[length(ac1)];
   for i := length(ac1) downto 2 do ac1[i] := ac1[i-1];
   ac1[1] := r;
   r := '0';
end; { shift }

(* Musterloesung Teil c *)
(* addiert mult auf r und ac1,
 * falls die letzte Stelle von ac0 1 ist *)
procedure add(mult : string; var r: char; var ac1,ac0 : string);
(* ac0 koennte durchaus auch als Werte-, statt als Referenzparameter
 * uebergeben werden
 *)
var i,uebertrag : integer;
begin
   if (ac0[length(ac0)]='1') then begin
      uebertrag := 0;
      for i:=length(ac1) downto 1 do begin
         (* In uebertrag werden alle drei Ziffern aufsummiert:
          * die Stelle i von AC1, die Stelle i des Multiplikators,
          * und der Uebertrag aus der Berechnung der vorigen Stelle
          * (dieser steht schon in der Varoablen uebertrag).
          *)
         if (ac1[i]='1') then uebertrag := uebertrag + 1;
         if (mult[i]='1') then uebertrag := uebertrag +1;
         (* Es ergibt sich eine Zahl zwischen 0 und 3,
          * d.h. eine bis zu zweistellige Binaerzahl.
          * Das hoeherwertige Bit ist der neue Uebertrag,
          * das niederwertige Bit wird in AC1 an die Stelle i
          * geschrieben.
          *)
         if (uebertrag mod 2 = 0) then ac1[i] := '0' else ac1[i] := '1';
         if (uebertrag div 2 = 1) then uebertrag := 1 else uebertrag := 0;
      end;
      if (uebertrag = 1) then r := '1' else r := '0';
   end;
end; { add }

procedure vnmult(x,y: integer);
var ac1,ac0 : string;
    r       : char;
    z,i     : integer;
    mult    : string;
begin
   r := '0';
   z := getBinLength(x,y);
   ac1 := int2binstr(0,z);
   ac0 := int2binstr(x,z);
   mult := int2binstr(y,z);
   writeln('z=',z,', mult=',mult,', ac0=',ac0);
   writeln;
   for i:=z downto 1 do begin
      writeln('R|AC1|AC0 vor Add:    ',r,'|',ac1,'|',ac0);
      add(mult,r,ac1,ac0);
      writeln('R|AC1|AC0 nach Add:   ',r,'|',ac1,'|',ac0);
      shift(r,ac1,ac0);
      writeln('R|AC1|AC0 nach Shift: ',r,'|',ac1,'|',ac0);
      writeln('z=',i-1);
      writeln;
   end;
   writeln('Das Ergebnis lautet: ',r,ac1,ac0);
end; { vnmult }
   
begin
   write('Bitte den ersten Faktor (dezimal) eingeben:  ');
   readln(a);
   write('Bitte den zweiten Faktor (dezimal) eingeben: ');
   readln(b);
   vnmult(a,b);
end.