
A N E X A   2

Sursele Pascal ale unitatii ARITMBIN

{ ====================== ARITMBIN ======================= }
      { Simuleaza aritmetica binara fara semn si aritmetica
         in cod complementar. Toti operanzii sunt stringuri
        avand numai caracterele '0' si '1', numite "biti" }
{$I-,R-,D-,B-,S-,V-}

UNIT ARITMBIN;

INTERFACE
  function deplasari (s: string; c: char;
                      n: byte; sens: integer): string;
  function complement(s    : string         ): string;
  function plusfs    (a,  b: string; n: byte): string;
  function timesfs   (M,  Q: string; n: byte): string;
  function dividefs  (AQ, M: string; n: byte): string;
  function timescc   (M,  Q: string; n: byte): string;
  function dividecc  (AQ, M: string; n: byte): string;

IMPLEMENTATION
uses B2toZ;

{ ====================== DEPLASARI ====================== }
     { Efectueaza deplasarea spre stanga sau spre dreapta a
       stringului s, eventual doar se redimensioneaza sirul
la n caractere. In locul caracterului disponibil se pune c.
                      sens = -1 ==> deplasare spre stanga ;
                      sens =  1 ==> deplasare spre dreapta;
                      sens =  0 ==> ajustarea stringului. }
function deplasari(s: string; c: char;
                   n: byte; sens: integer): string;
begin  case sens of
    0:  begin
          if length(s) > n then delete(s, 1, length(s) - n);
          while length(s) < n do s := c + s       end;
   -1:  begin delete(s,1,1);         s := s + '0' end;
    1:  begin delete(s,length(s),1); s := c + s   end
  end;  deplasari := s  end; { deplasari }

{ ====================== COMPLEMENT ===================== }
               { Intoarce codul complementar al sirului s }
function complement(s: string): string;
var  i, j: byte;
begin
  complement := s;
  if Pos('1', s) = 0 then  EXIT;
  i := length(s);
  while s[i] = '0' do i := i - 1;
  for j := 1 to i-1 do
    if s[j] = '0' then s[j] := '1'
                  else s[j] := '0';
  complement := s
end; { complement }

{ ====================== PLUSFS ========================= }
                 { Aduna numerele binare fara semn a si b }
function plusfs (a, b: string; n: byte): string;
var  c: string;
begin
  a := a + '2';       b := b + '2';
  c := plus(a, b);
  delete(c, length(c), 1);
  plusfs := deplasari(c, '0', n, 0)
end; { plusfs }

{ ====================== TIMESFS ======================== }
           { Intoarce produsul numerelor fara semn M si Q }
function timesfs(M,  Q: string; n: byte): string;
var  i: byte;   s, A: string;  C: char;
begin
  M := deplasari(M,'0',n,0);   Q := deplasari(Q,'0',n,0);
  C := '0';                    A := deplasari('','0',n,0);
  for i := 1 to n do begin
    if Q[length(Q)] = '1' then begin
      s := plusfs(A, M, n+1);
      C := s[1]; A := Copy(s, 2, length(s)-1)
    end;
    s := deplasari(C+A+Q, '0', 2*n+1, 1);
    C := s[1]; A := Copy(s,2,n);      Q := Copy(s,n+2,n);
  end;
  timesfs := A + Q
end; { timesfs }

{ ====================== DIVIDEFS ======================= }
         { Imparte numarul AQ la numarul M, furnizand catul
            si restul impartirii, pe cate n biti fiecare. }
function dividefs(AQ, M: string; n: byte): string;
var  i: byte;  s, A, Q: string;  C: char;
begin
  AQ := deplasari(AQ,'0',2*n,0); M := deplasari(M,'0',n,0);
  A := Copy(AQ,1,n);             Q := Copy(AQ,n+1,n);
  for i := 1 to n do begin
    s := deplasari(C+A+Q,'0',2*n+1,-1);
    C := s[1]; A := Copy(s,2,n); Q := Copy(s,n+2,n);
    if C+a >= deplasari(M,'0',n+1,0) then          begin
      Q[length(Q)] := '1';
      s := plusfs(C+A, complement('0'+M), n+1);
      C := s[1];               A := Copy(s,2,n)    end
  end;
  dividefs := Q+'C'+A+'R'
end; { dividefs }

{ ====================== TIMESCC ======================== }
                 { Inmulteste munerele M si Q, reprezentate
                                     in cod complementar. }
function timescc(M, Q: string; n: byte): string;
var  i: byte;  s, A: string;  Q_1: char;
begin
  A := deplasari('', '0', n, 0);              Q_1 := '0';
  M := deplasari(M,M[1],n,0); Q := deplasari(Q,Q[1],n,0);
  for i := 1 to n do begin
    if      Q[length(Q)]+Q_1 = '01' then
                        A := plusfs(A, M, n)
    else if Q[length(Q)]+Q_1 = '10' then
                        A := plusfs(A, complement(M), n);
    s := deplasari(A+Q+Q_1, A[1], 2*n+1, 1);
    A := Copy(s,1,n); Q := Copy(s,n+1,n); Q_1 := s[2*n+1]
  end;
  timescc := A+Q
end; { timescc }

{ ====================== DIVIDECC ======================= }
        { Imparte in cod complementar numarul AQ la numarul
                            M, furnizand catul si restul. }
function dividecc(AQ, M: string; n: byte): string;
var  i: byte;   s, A, Q, OldA: string;   SignA: char;
begin
  AQ := deplasari(AQ, AQ[1], 2*n, 0);
  M := deplasari(M,    M[1],   n, 0);
  A := Copy(AQ,1,n); Q := Copy(AQ,n+1,n);
  SignA := A[1];
  for i := 1 to n do begin
    s := deplasari(A+Q, '0', 2*n, -1);
    A := Copy(s, 1, n); Q := Copy(s, n+1, n);
    OldA := A;
    if SignA = M[1] then A := plusfs(A, complement(M), n)
                    else A := plusfs (A, M, n);
    if  (SignA = A[1])  or (Pos('1',A+Copy(Q,1,n-i)) = 0)
       then Q[length(Q)] := '1'
       else A := OldA
  end;
  if SignA <> M[1] then Q := Complement(Q);
  dividecc := Q+'C'+A+'R'
end; { dividecc }

END. { ARITMBIN }

