2006年に授業で作った多倍長電卓。

taketa.pas

program TaketaDentaku(input, output);

const KETA_MAX = 30;

type su = array[0 .. KETA_MAX - 1] of integer;
type kazu = record
  plus:    Boolean;
  keta:    integer;
  abs:    su;
end;

var ans, arg:  kazu;
var op, c:    char;


function CountKeta(num: su): integer;
var i: integer; p: Boolean;
begin
  i := KETA_MAX - 1;
  p := true;
  while (p) do begin
    if (i < 0) then begin
      CountKeta := -1;
      p := false;
    end
    else begin
      if (num[i] > 0) then begin
        CountKeta := i;
        p := false;
      end;
      i := i - 1;
    end;
  end;
end;


function isLargeAbs(large, small: su): Boolean;
var i: integer; p: Boolean;
begin
  i := KETA_MAX - 1;
  p := true;
  while (p) do begin
    if (i = -1) then begin
      isLargeAbs := true;
      p := false;
    end
    else begin
      if (large[i] = small[i]) then
        i := i - 1
      else begin
        if (large[i] > small[i])
          then isLargeAbs := true
          else isLargeAbs := false;
        p := false;
      end;
    end;
  end;
end;


procedure SubAbs(x, y: su; var ans: su);
var i: integer;
begin
  for i := 0 to KETA_MAX - 1 do begin
    ans[i] := x[i] - y[i];
    if (ans[i] < 0) then begin
      ans[i] := ans[i] + 10;
      if (i + 1 < KETA_MAX) then x[i + 1] := x[i + 1] - 1;
    end;
  end;
end;


procedure Yomikomi(var num: kazu);
var x: su; i, n: integer; c: char; p: Boolean;
begin
  for i := 0 to KETA_MAX - 1 do begin
    x[i] := 0;
    num.abs[i] := 0;
  end;
  n := 0;
  num.plus := true;
  p := true;
  
  read(c);
  while (ord(c) >= ord('0')) and (ord(c) <= ord('9')) or (p) do begin  
    if (c = '-') and (p) then num.plus := false
    else begin
      x[KETA_MAX - 1 - n] := ord(c) - ord('0');
      n := n + 1;
    end;
    p := false;
    read(c);
  end;
  for i := 0 to n - 1 do
    num.abs[i] := x[KETA_MAX - n + i];
  num.keta := n - 1;
end;


procedure Kakidashi(num: kazu; isSpace: Boolean);
var i: integer; p: Boolean;
begin
  p := false;
  if (isSpace) then begin
    if (num.plus)
      then write('  ')
      else write(' ');
  end;
  for i := KETA_MAX - 1 downto 0 do begin
    if (num.abs[i] > 0) and (not p) then begin
      if (not num.plus) then write('-');
      p := true;
    end;
    if (p) then write(num.abs[i])
    else begin
      if (i = 0) then begin
        if (not num.plus) and (isSpace) then write(' ');
        write(num.abs[0]);
      end
      else if (isSpace) then write(' ');
    end;
  end;
end;


procedure Add(x, y: kazu; var ans: kazu);
var i: integer;
begin
  if (x.plus = y.plus) then begin
    for i := 0 to KETA_MAX - 1 do begin
      ans.abs[i] := x.abs[i] + y.abs[i];
      if (ans.abs[i] >= 10) then begin
        ans.abs[i] := ans.abs[i] - 10;
        if (i + 1 < KETA_MAX) then x.abs[i + 1] := x.abs[i + 1] + 1;
      end;
    end;
    ans.plus := x.plus;
  end
  else begin
    if (isLargeAbs(x.abs, y.abs)) then begin
      SubAbs(x.abs, y.abs, ans.abs);
    end
    else begin
      SubAbs(y.abs, x.abs, ans.abs);
      ans.plus := y.plus;
    end;
  end;
end;


procedure Mul(x, y: kazu; var ans: kazu);
var i, j: integer;
begin
  for i := 0 to KETA_MAX - 1 do ans.abs[i] := 0;
    
  for i := 0 to x.keta do begin
    for j := 0 to y.keta do begin
      if (i + j < KETA_MAX) then begin
        ans.abs[i + j] := x.abs[i] * y.abs[j] + ans.abs[i + j];
        if (ans.abs[i + j] >= 10) then begin
          if (i + j + 1 < KETA_MAX) then ans.abs[i + j + 1] := ans.abs[i + j] div 10 + ans.abs[i + j + 1];
          ans.abs[i + j] := ans.abs[i + j] mod 10;
        end;
      end;
    end;
  end;
  if (x.plus = y.plus)
    then ans.plus := true
    else ans.plus := false;
end;


procedure Divide(x, y: kazu; var ans: kazu);
var xx, yy: su; i, j: integer; p: Boolean;
begin
  p := false;
  for i := 0 to KETA_MAX - 1 do begin
    if (y.abs[i] > 0) then p := true;
  end;

  if (p) then begin
    for i := 0 to KETA_MAX - 1 do begin
      xx[i] := 0;
      ans.abs[i] := 0;
    end;
    yy := y.abs;
    p := false;
    
    for i := x.keta downto 0 do begin
      for j := x.keta downto 1 do xx[j] := xx[j - 1];
      xx[0] := x.abs[i];
      while (isLargeAbs(xx, yy)) do begin
        SubAbs(xx, yy, xx);
        ans.abs[i] := ans.abs[i] + 1;
      end;
    end;
    if (x.plus = y.plus)
      then ans.plus := true
      else ans.plus := false;
  end
  else writeln('        ******** 計算できません ********');
end;


begin
  writeln;
  writeln('  *************************');
  writeln('  **     多 桁 電 卓     **');
  writeln('  *************************');
  writeln;
  writeln('30 桁 までの数を計算できる演算機です。');
  writeln;
  writeln('  途中の解  :  演算子 数');
  writeln;
  writeln('の形で、式を入力する度に計算結果を表示します。');
  writeln('(演算子と数の間はスペースを挿入して下さい。)');
  writeln;
  write('最初の数  =>  ');
  Yomikomi(ans);
  writeln;
  Kakidashi(ans, true);
  write('  :  ');
  read(op);
  while op <> '=' do begin
    read(c);
    Yomikomi(arg);
    case op of
      '+': Add(ans, arg, ans);
      '-': begin
        arg.plus := not arg.plus;
        Add(ans, arg, ans);
      end;
      '*': Mul(ans, arg, ans);
      '/': Divide(ans, arg, ans);
    end;
    ans.keta := CountKeta(ans.abs);
    Kakidashi(ans, true);
    write('  :  ');
    read(op);
  end;
  writeln;
  write('計算結果  =>  ');
  Kakidashi(ans, false);
  writeln;
  writeln;
end.