47 lines
1.3 KiB
Text
47 lines
1.3 KiB
Text
/* Multiply a by b, giving c. */
|
|
multiply: procedure (a, b, c);
|
|
declare (a, b, c) (*) fixed decimal (1);
|
|
declare (d, e, f) (hbound(a,1)) fixed decimal (1);
|
|
declare pr (-hbound(a,1) : hbound(a,1)) fixed decimal (1);
|
|
declare p fixed decimal (2), (carry, s) fixed decimal (1);
|
|
declare neg bit (1) aligned;
|
|
declare (i, j, n, offset) fixed binary (31);
|
|
|
|
n = hbound(a,1);
|
|
d = a;
|
|
e = b;
|
|
s = a(1) + b(1);
|
|
neg = (s = 9);
|
|
if a(1) = 9 then call complement (d);
|
|
if b(1) = 9 then call complement (e);
|
|
pr = 0;
|
|
offset = 0; carry = 0;
|
|
do i = n to 1 by -1;
|
|
do j = n to 1 by -1;
|
|
p = d(i) * e(j) + pr(j-offset) + carry;
|
|
if p > 9 then do; carry = p/10; p = mod(p, 10); end; else carry = 0;
|
|
pr(j-offset) = p;
|
|
end;
|
|
offset = offset + 1;
|
|
end;
|
|
do i = hbound(a,1) to 1 by -1;
|
|
c(i) = pr(i);
|
|
end;
|
|
do i = -hbound(a,1) to 1;
|
|
if pr(i) ^= 0 then signal fixedoverflow;
|
|
end;
|
|
if neg then call complement (c);
|
|
end multiply;
|
|
|
|
complement: procedure (a);
|
|
declare a(*) fixed decimal (1);
|
|
declare i fixed binary (31), carry fixed decimal (1);
|
|
declare s fixed decimal (2);
|
|
|
|
carry = 1;
|
|
do i = hbound(a,1) to 1 by -1;
|
|
s = 9 - a(i) + carry;
|
|
if s > 9 then do; s = s - 10; carry = 1; end; else carry = 0;
|
|
a(i) = s;
|
|
end;
|
|
end complement;
|